perm filename MUSIC.FAI[2,LCS] blob
sn#155840 filedate 1975-04-23 generic text, type T, neo UTF8
;;;****** AS OF JAN. 12, 1971 *********
↓T←1
T1←2
T2←3
T3←4
A←5
B ←6
C←7
D←10
E←11
F←12
H←14
OSP←13
↓P←15
↓FL←17
NACS←←5
NFACS←←4
INSXR←←NFACS-1
SSPCF←←10
SDFLG←←20
SNUMF←←40
FIXFLG←←1000
FLTFLG←←2000
DF←←400000
NUMFLG←←FIXFLG+FLTFLG
SSPC2F←←4000
RFLG←←0 ;$$$%%&%$###""##$%$$$$$
DECLBIT←←400
RVBT←←400
PRVBT←←11
MULBIT←←1
ADDBIT←←2
FOOBIT←←100
INSBIT←←40
UGBIT←←4000
FPARBT←←200
SRACBT←←10000
SIACBT←←20000
GPBIT←←FOOBIT ;NOT I OR X.
FUNBIT←←40000
SWVBT←←100000 ;DO NOT CHANGE ! SEE GFUNC.
VRBLBT←←200000
;; RELOCATION AND FIXUP BITS .
.FXBTS←←1
LFXBTS←←2
VRELBT←←14+1
RRELBT←←4+1
IRELBT←←10+1
;; FLAGS (RIGHT HALF):
CSBRBT←←1
SFOOBT←←10
USBRBT←←2
GFUNCF←←4
EXTFLG←←40
ARRFLG←←20
RVFLG←←100
RESTART←←200
;FLAGS (LEFT HALF).
ERRFLG←←1
MINFLG←←2
SNUMF1←←4
NOSTAR←←10
DTFLG←←20
;; PARAMETER DESCRIPTOR BITS:
FAOPAR←←1
FDPARB←←4
FDPARC←←5
COFF←←1000 ;PI CHANNEL OFF.
CON←←2000
DACHN←←100 ;PI CHANNEL 1.
LRFXBT←←200000 ;LEFT HALF REPLACEMENT FIXUP BIT.
RRFXBT←←100000 ;RIGHT HALF.
SWAPBT←←40000 ;SWAPPED FIXUP.
DEFINE IOWD (A,B) <XWD -A,B-1>
OPDEF EXP [0]
;**** NO HARDWARE FIX AT CMU
;OPDEF FIX [XWD 247000,0] ;FOR PDP10 ONLY. REMOVE WITH DDT FOR PDP6
LOC 41
JSR UUOSER
RELOC
OPDEF JRSTF [JRST 2,]
OPDEF FIX [XWD 2000,0]
UUOSER: 0
MOVEM A,SAVEA#
HLRZ A,40
CAIL A,2000
JRST FIXER
MOVE A,SAVEA
JSR ERR1
JRSTF @UUOSER
FIXER: MOVE A,SAVEA
MOVEM P,SAVEP#
LDB P,[POINT 4,40,12]
EXCH B,(P)
MOVEM A,SAVEA
HRLE A,40
UFA A,B
JUMPE B,ZERO
TDC B,A
ZERO: MOVE A,SAVEA
EXCH B,(P)
MOVE P,SAVEP
JRSTF @UUOSER
;*** END OF FIXER PATCH
OPDEF OUTCHR [XWD 51040,0]
;****** THIS REQUIRES 'USETI' TO PRESERVE POINTERS TO PROG. WHEN SAVED.
;BEGIN SAVER
; (INSERTED 11/3/69)
; TO DUMP CORE IMAGE
; CREATE A FILE OF THE CURRENT CORE IMAGE.
; PICK UP THE USER'S INPUT FILE NAME STORED
; IN DLK AND CREATE A FILE CALLED:
; "NAME.SAV"
; WHERE NAME IS THE INPUT FILE NAME.
;
; THE SWAP UU0 WILL BE USED WHICH CLOSES ALL
; ACTIVE DEVICES.
;
; ACCUMULATORS 0 AND T WILL BE CLOBBERED BY THIS
; ROUTINE. ALL OTHERS WILL BE SAVED AND RESTORED.
;;INTERNAL SAVER
;↑SAVER: 0
; MOVE 0,SCP ;BASE OF INPUT BUFFER
; HRRZ T,IBUF ;CURRENT BUFFER
; SUBI 0,-BUF1-1(T) ;DIFFERENCE
; MOVEM 0,PLIST+LPLIST-10
; MOVEM 17,ACS+17 ;SAVE REGISTERS
; MOVEI 17,ACS
; BLT 17,ACS+16
; SKIPN T,DLK ;INPUT FILE NAME
; MOVSI T,'SAV'
; MOVEM T,SWPTBL+1
; MOVSI T,SWPTBL ;ADDR OF 5 WORD BLOCK IN LEFT PART OF T
; CALL T,[SIXBIT /SWAP/]
;RETR: MOVE P,[XWD -10,PLIST+LPLIST-10] ;PICK UP ACCUM P
; MOVEI FL,RESTART ;RESTORE RESTART FLAG
; SOS RECCT; ; ;BACK UP TO PREVIOUS INPUT RECORD.
; PUSHJ P,SETUP ;JUMP TO RESTORE FILES
; POP P,SCP
; MOVEI GO
; HRRM JOBSA
; MOVSI 17,ACS ;RESTORE REGISTERS
; BLT 17,17
; JRA 16,(16)
;ACS: BLOCK 20; ;REGISTER SAVE AREA
;SWPTBL: SIXBIT /DSK/ ;DEVICE FOR SWAP
; 0; ; ;FOR FILENAME
; SIXBIT /SAV/ ;FILENAME.SAV
; RETR ;CORE SIZE (0=USE WHAT YOU NEED)
; 0; ; ;END OF LIST
;BEND SAVER
;INPUT ROUTINE. CALL INITIALLY WITH PUSHJ P,SETUP
;WILL READIN DTA# AND FILE NAME. GET CHRS BY
;ILDB IBUF+1. NEXT BUFFER BY INPUT DT,0.
TITLE MUSIC
;;;EXTERNAL IFIX
EXTERNAL SMPLS
EXTERNAL READIN
TTY←←1
DT←←2
ADCHN←←3
SETUP: CALL [SIXBIT /RESET/]
SETUP1: INIT TTY,1
SIXBIT /TTY/
XWD TOB,TIB
CALL [SIXBIT /EXIT/]; ERROR CONDITION
MOVSI 400000
ANDCAM TIBUF+1 ;MARK INPUT BUFFERS EMPTY.
ANDCAM BUF1+1
ANDCAM BUF2+1
ANDCAM BUF3+1
HRRI TIBUF+1 ;INIT. BUFFER POINTERS.
MOVEM TIB
HRRI TOBUF+1
MOVEM TOB
;; OUTPUT TTY,1; SEE THE HAPPY SYSTEM
OUTPUT TTY, ;FOR STANDARD SYSTEM(EXPORT)
TRNE FL,RESTART ;ARE WE RESTARTINIG ?
JRST SET4 ;YES.
MOVEI IMS
JSR TXTOUT; A LF/CR *
EXTERNAL FILBRK,DLK,ASTR
INTERNAL DEV
SETZM ASTR
JSA 16,FILBRK
MOVE T2,[SIXBIT/TTY/]
SKIPN DLK
MOVEM T2,DNAM
JRST SET4
;THE FOLLOW CODE IS UNNECSSARY BECAUSE OF FILBRK
;; INPUT TTY,0; THE DTA # AND NAME
;; SETZM DNAM
;; MOVE 2,[POINT 6,DNAM]
;; MOVEI T2,6
;;SET3: ILDB TIB+1
;; CAIN ":"
;; JRST SET4
;; SUBI 40
;; IDPB 2
;; SOJG T2,SET3
SET4: INIT DT,1
DNAM:DEV: SIXBIT /DTA/
XWD 0,IBUF ;NO OUPUT ON THIS DEVICE.
JRST AER1
MOVE [XWD 400000,BUF1+1] ;SET UP BUFFER
MOVEM IBUF ;HEADER SO SYSTEM WILL USE OUR BUFFERS.
MOVSI 700
MOVEM SCP ;BYTE SIZE.
; SETZM DLK+3 ;TO READ FILES OFF DSK
TRZE FL,RESTART
JRST SETIN
;*** NEXT TWO ARE FOR 'SAVER'
; MOVEI T,1
; MOVEM T,RECCT
JRST SETIN
;THE FOLLOW CODE IS TAKEN CARE OF BY FILBRK
MOVE T1,[POINT 6,DLK]
SETZM DLK
SETZM DLK+1
MOVEI T2,12
RIN: ILDB TIB+1; GET FILE NAME
CAIN 15
JRST SETIN
CAIN "."; AN EXTENSION
JRST SETEX
SUBI 40
IDPB T1
SOJG T2,RIN
JRST SETIN
TIB: 0
POINT 7,0,35
0
TOB: 0
POINT 7,0,35
0
TIBUF: 0
XWD 21,.
BLOCK 22
TOBUF: 0
XWD 21,.
BLOCK 22
;THIS IS NOW IN FILBRK DLK: BLOCK 4
IBUF: XWD 400000,BUF1+1; MAGIC TO KEEP SYSTEM
SCP: POINT 7,0,35; HAPPY
ICCNT: 0 ;BUFFER CHAR. COUNT.
SETEX: TLZ T1,770000
JRST RIN
SETIN: LOOKUP DT,DLK; GET FILE SETUP
JRST NER; NON-EX FILE
PUSHJ P,RDBUF ;GET FIRST BUFFER
MOVE BUF1+3 ;LINE NO. FIRST ?
TRNE 1
AOS SCP ;YES; ADVANCE SCP PAST IT.
SETZM SNCHR
SETZM FOONLY# ;BARF !!
POPJ P,; DONE
BUF1: 0
XWD 201,BUF2+1
BLOCK 202
BUF2: 0
XWD 201,BUF3+1
BLOCK 202
BUF3: 0
XWD 201,BUF1+1
BLOCK 202
AER1: MOVEI DEV1MS; ERROR ROUTINE FOR NOT AVAILABLE
JSR TXTOUT; DECTAPE
MOVEI T1,4
MOVEI DNAM
PUSHJ P,SIXOUT
MOVEI DEV2MS
JSR TXTOUT
JRST SETUP
NER: MOVEI NAM1MS
JSR TXTOUT
MOVEI T1,6
MOVEI DLK
PUSHJ P,SIXOUT
HLRZ DLK+1
JUMPE NEX1
MOVEI "."
IDPB TOB+1
MOVEI T1,3
MOVEI DLK+1
PUSHJ P,SIXOUT
NEX1: MOVEI NAM2MS
JSR TXTOUT
JRST SETUP
NAM1MS: ASCIZ /
FILE /
NAM2MS: ASCIZ / NOT FOUND
/
DECPNT: PUSHJ P,DECPNN ;SPACE COMES AFTER NUM IS TYPED.
MOVEI A,40
SOSGE TOB+2
OUTPUT TTY,0
IDPB A,TOB+1
POPJ P,
DECPNN: IDIVI A,12 ;PRINT DECIMAL INTEGER FROM A.
HRLM B,(P) ;SAVE LOW ORDER DIGIT.
SKIPE A ;DONE ?
PUSHJ P,DECPNN ;NO. RECUR FOR REST OF DIGITS.
HLRZ A,(P) ;YES. GET HIGH ORDER DIGIT.
ADDI A,"0" ;CONVERT TO ASCII.
SOSGE TOB+2 ;OUTPUT IT.
OUTPUT TTY,0
IDPB A,TOB+1
POPJ P, ;RETURN.
SIXOUT: TLO 440600 ; MAKE BYTE POINTER
LOOPTS: SOJL T1,[POPJ P,]
ILDB T,0
JUMPE T,[POPJ P,]
ADDI T,40
IDPB T,TOB+1
JRST LOOPTS
TXTOUT: 0
TLO 440700; ANOTHER POINTER
LPT1: ILDB T,0
JUMPE T,RETPT
SOSGE TOB+2
OUTPUT TTY,0
IDPB T,TOB+1
JRST LPT1
RETPT: OUTPUT TTY,0
JRST @TXTOUT
DEV1MS: ASCIZ /
DEVICE /
DEV2MS: ASCIZ / NOT AVAILABLE
/
IMS: ASCIZ /
* INPUT ? /
RDBUF: MOVEI [BYTE (7)15,12,52] ;ASCIZ / CR LF */
MOVSI A,'TTY'
CAME A,DNAM ;IS INPUT DEVICE A TTY ?
TLO FL,NOSTAR ;NO. SUPRESS THE *.
TLZN FL,NOSTAR ;PRINT IF NOSTAR NOT ON.
CALLI 3 ;YES. TYPE CR LF *.
;***** NEXT TWO FOR 'SAVER'
; USETI DT,@RECCT# ;POSITION INPUT FILE TO RIGHT RECORD.
; AOS RECCT ;ADD 1 TO RECORD CTR
INPUT DT,0 ;READ NEW INPUT BUFFER.
STATZ DT,20000 ;END OF FILE SEEN ?
JRST SETUP ;YES.
MOVEI 4 ;MAKE SURE 0 WORD TERMINATES IT.
ADD ICCNT ;CHAR. COUNT +4/5 IS WORD COUNT.
MOVEI A,5 ;BECAUSE WE DON'T WANT TO LOSE B.
IDIVM A ;SEE? NO RANDOM REMAINDER !!
ADD A,SCP ;ADD BASE ADDRESS.
IBP A ;BAGBITING SYSTEM.
SETZM (A) ;ZERO IT.
MOVE SCP
MOVEM ISCP# ;SAVE FOR ERROR PRINTOUT.
POPJ P,
SUBTTL ALGOL SCANNER -- 9/8/66 D. POOLE
;CALL IS PUSHJ P,-----. SCANS NEXT ATOMIC ELEMENT OF
; INPUT STRING, RETURNS ELEMENT IN ACCUM. 'A' AS FOLLOWS:
; UNDEFINED IDENTIFIER-- RETURNS 0.
; DECLARED IDENTIFIER--- 'A' CONTAINS RANDOM GOOD BITS FROM
; THE SYM. TBL. IN LEFT HALF, PTR. TO RGB WORD IN RT. HALF.
;RESERVED WORD OR SINGLE-CHARACTER OPERATOR--- 'A' CONTAINS
; THE RANDOM BITS WORD FROM EITHER THE RESERVED WORD TABLE
; OR THE CHAR. CONVERT TABLE, RESPECTIVELY.
BUCKNO←←1; SEE DFUNC BEFORE CHANGING !!!!
ACCUM: BLOCK 40 ;GOOD ENOUGH FOR NOW...
SCANNS: TLOA FL,NOSTAR ;SUPRESS PRINTING OF *.
SCANR: TLOA FL,400000 ;ENTRY WHEN EXPECTING OPERATOR OR
; RESERVED WORD.
SCANV: TLZ FL,400000 ;ENTRY WHEN EXPECTING VARIABLE.
SCAN:
SKIPE A,SNCHR# ;IF SNCHR IS NON-ZERO,
JRST SL1 ; IT IS THE NEXT CHAR. TO SCAN.
SL10: ILDB A,SCP ;GET NEXT CHAR.
SKIPN A,CTBL(A) ;SKIP LEADING BLANKS.
JRST SL10
JUMPL A,SL1A ;IF OPERATOR, WE'RE DONE.
TLNE A,SNUMF ;CHECK FOR PART OF A NUMBER.
JRST SNUM1
MOVE T2,[POINT 6,ACCUM,5] ;PREPARE TO SCAN AN
SETZB T,ACCUM ;IDENTIFIER.
MOVEM T,ACCUM+1
MOVEM A,FOONLY
SL2: IDPB A,T2 ;APPEND CHAR. TO IDENTIFIER.
ILDB A,SCP ;NEXT CHAR.
SKIPLE A,CTBL(A) ;CHECK FOR TERMINATOR.
AOJA T,SL2 ;INCREMENT COUNT AND LOOP.
TLNE A,SSPC2F ;DOES TERMINATING CHAR. REQUIRE
JRST SSPCB ;IMMEDIATE ATTENTION ?
MOVEM A,SNCHR ;NO, SAVE IT FOR NEXT TIME.
ADDI T,1
DPB T,[POINT 6,ACCUM,5] ;PUT COUNT IN FIRST CHAR.
HRRZS T2
SUBI T2,ACCUM
HRRZM T2,ACCWC#
MOVE A,ACCUM ;PREPARE TO SEARCH TABLES.
MOVE C,ACCUM+1
TLZE FL,400000 ;DO WE EXPECT AN OPERATOR ?
JRST SRSCH ;YES; SEARCH RES. WD. TBL. FIRST
SMSCH: MOVE T,A ;SEARCH MAIN SYM. TBL.
IDIVI T,BUCKNO ;DO HASH ON IDENT.
MOVMS T1 ;MAKE SURE IT'S POSITIVE.
MOVEM T1,CBNO# ;SAVE BUCKET NO.
HRRZ B,BUCTBL(T1) ;HEAD OF RIGHT BUCKET
; IN SYM. TBL.
SL5: CAMN A,1(B) ;COMPARE FIRST WORDS.
JRST SL4
SL6: HRRZ B,(B) ;GET NEXT ELEMENT OF
JRST SL5 ; THE LINKED LIST.
SL4: CAIN B,A-1 ;FIRST WORD WAS EQUAL...
JRST SNO ; WE ARE AT END OF BUCKET.
SKIPN T1,T2
JRST SFOUND ;ONLY 1 WORD; WE'RE DONE.
CAME C,3(B) ;COMPARE SECOND WORDS...
JRST SL6 ;NOPE.
SOJE T1,SFOUND ;ANY MORE WORDS ?
MOVE T3,[XWD B,4]; YES. PREPARE TO CHECK THEM.
SL7: MOVE D,ACCUM-2(T3)
CAME D,@T3
JRST SL6 ;NOT EQUAL.
SOJE T1,SFOUND ;MORE STILL ?
AOJA T3,SL7 ;YES; KEEP CHECKING.
SFOUND: MOVEI A,2(B) ;FOUND HIM; CALC. PTR. TO RGB WORD.
HLL A,(A) ;GET RANDOM GOOD BITS.
HRRZ B,A
SEXIT: CAIG T2,1 ;MORE THAN 2 WORDS OF NAME ?
POPJ P, ;NO.
SETZM ACCUM(T2) ;YES; ZERO OUT ALL THE WORDS OF
SOJA T2,SEXIT ; ACCUM THAT WE USED.
SNO: TLCN FL,400000 ;NOT IN MAIN TBL; HAVE WE ALREADY
JRST SRSCH ; SEARCHED RES. WORD TBL ?
SN1: MOVE A,FOONLY ;GARPBAZ !
TLNE A,FOOBIT
JRST FOOSCH
SCH1: SETZB A,B ;YES. RETURN 'UNDEFINED'.
POPJ P,
SL1: SETZM SNCHR ;RETURN FOR A SPECIAL CHAR.
SL1A: TLNN A,SSPCF+SSPC2F ;DOES IT NEED SPECIAL SERVICE ?
POPJ P, ;NO.
PUSHJ P,(A) ;YES. DISPATCH ON IT.
JRST SL10 ;CONTINUE SCANNING.
FOOSCH: LDB B,[POINT 6,ACCUM,17]
TRNE FL,SFOOBT ;ARE WE DEFINING A FUNCTION ?
JRST SCH1 ;YES. NO FOO-SYMBOLS ALLOWED.
CAIG B,31 ;IS IT A DIGIT?
CAIGE B,20
JRST SCH1 ;NO.
SUBI B,20 ; TO VALUE.
LDB C,[POINT 6,ACCUM,23]
JUMPE C,FSCH1
LDB D,[POINT 6,ACCUM,29]
JUMPN D,SCH1
IMULI B,12 ;MUL. TENS DIGIT BY 10.
CAIG C,31
CAIGE C,20
JRST SCH1
ADDI B,-20(C) ;ADD IN ONE'S DIGIT.
FSCH1: DPB B,[POINT 17,A,35] ;PUT NUMBER IN A.
POPJ P, ;RETURN FROM SCAN.
S.VT: ;HERE ON VERTICAL TAB.
S.FF: ;FORM FEED.
S.LF: ;LINE FEED
SENDL: TLZ FL,ERRFLG ;END OF LINE. CLEAR ERROR FLAG.
MOVEI A,1
ADD A,SCP ;GET PTR TO NEXT WORD.
SKIPN T,(A)
JRST S.EOB ;ZERO WORD MEANS END OF BUFFER.
TRNN T,1 ;IS IT A LINE NO. ?
POPJ P, ;NO; CONTINUE SCANNING.
TLZ A,770000 ;YES; ADVANCE PTR. PAST IT.
MOVEM A,SCP
POPJ P,
S.EOB: PUSHJ P,RDBUF ;REFILL BUFFER.
JRST SENDL
SSPCB: HALT
SSPCC: HALT
S.LT: ILDB A,SCP ;'<' SEEN; SKIP TO END OF LINE.
CAIE A,12 ;A LINE FEED ?
JRST S.LT ;NO.
JRST SENDL
SNUM1: MOVEI C,0 ;NUMBER SCANNER.
CAMN A,DOTV ;FIRST THING A DECIMAL PT.?
JRST SNUM6 ;YES
MOVNI T,100 ;NO DEC PT. YET.
SNUM2: IMULI C,12
ADDI C,-20(A) ;CONVERT NEW DIGIT TO VALUE AND ADD IN
AOSA T ;INCREMENT DEC. PLACE COUNT.
SNUM6: MOVEI T,0 ;START COUNTING DEC. PLACES.
ILDB A,SCP ;NEXT CHAR.
SKIPG A,CTBL(A) ;GET MAGIC BITS.
JRST SNUM7 ;IT'S A DELIMITER.
TLNE A,SDFLG ;IS IT A DIGIT ?
JRST SNUM2 ;YES.
CAMN A,DOTV ;A DEC. PT. ?
JRST SNUM6 ;YES.
JRST SNUMX1
SNUM7: TLNE A,SSPC2F ;DOES DELIM. REQUIRE INSTANT SERVICE ?
JRST SSPCC ;YES.
MOVEM A,SNCHR ;SAVE FOR NEXT TIME.
; JUMPLE T,SNFX ;IF NO DEC. PT. SEEN, IT'S FIXED PT.
SFLTIT: IDIVI C,400000 ;FLOAT IT.
SKIPE C
TLC C,254000
TLC D,233000
FAD C,D
SKIPLE T
FDVR C,[10.0] ;DIVIDE BY 10 ENOUGH TO GET
SOJG T,.-1 ;DEC. PT. IN RIGHT PLACE.
SKIPA T,[XWD FLTFLG,0] ;GET FLOATING PT. FLAG.
SNFX: MOVSI T,FIXFLG
HLLZ A,T ;COPY FLAG TO A.
TRNN FL,SFOOBT
TLZE FL,SNUMF1
POPJ P,
;; NOW SEARCH NUMBER TABLE FOR THE NUMBER.
TDOA A,NUMBUC ;NUMBUC TO RT. HALF.
SNUM4: HRR A,-1(A) ;GET NEXT LINK.
CAME C,(A) ;IS IT EQUAL ?
JRST .-2 ;NO.
TRNN A,777760 ;ARE WE AT END OF TABLE ?
JRST SNUMNO ;YES.
TDNN T,-1(A) ;NO. DO TYPES MATCH ?
JRST SNUM4 ;NO.
POPJ P, ;YUP. WE'VE FOUND IT.
SNUMNO: TRNE FL,CSBRBT ;ARE WE INSIDE A FUNCTION DEFINITION ?
JRST SNUMX ;YES.
AOS B,JOBFF ;INSERT NEW NUMBER IN TABLE.
HRR A,B
EXCH B,NUMBUC ;UPDATE NUMBUC.
HRRM B,-1(A) ;PUT IN NEW LINK.
HLLM A,-1(A) ;PUT IN TYPE FLAG.
MOVEM C,(A) ;ALSO VALUE.
AOS T,JOBFF ;BUMP POINTER PAST VALUE.
HRLM T,JOBSA
POPJ P,
SNUMX: IOR T,VLOC ;WE WILL PUT NO. IN VARIABLES AREA.
PUSH P,T ;SAVE PTR. TO LOC.
MOVE A,C ;VALUE OF NO. TO A.
MOVEI B,0 ;NO RELOCATION.
PUSHJ P,EMVCDI ;EMIT TO VARIABLES BUFFER.
JRST POPAJ ;SEE EMINST.
; RESERVED WORD TABLE SEARCHER.
SRSCH: LDB B,[POINT 6,ACCUM,5] ;GET CHAR. COUNT.
CAIL B,3 ;NO 1-CHAR. RES. WDS.
CAILE B,13 ;ALSO NONE OF > 9 CHARS.
JRST SRNO
MOVE B,SRTBL1-2(B) ;GET RIGHT SECTION OF TBL.
CAME A,(B) ;COMPARE FIRST WORD.
SRS1: AOBJN B,.-1
JUMPGE B,SRNO ;ARE WE AT END OF SETCTION ?
CAME C,LRTBL(B) ;NO; COMPARE SECOND WORD.
JRST SRS1
MOVE A,2*LRTBL(B) ;THIS IS IT; GET GOOD BITS.
TLNE A,SSPCF ;DOES IT NEED OUR ATTENTION ?
JRST (A) ;YES.
JRST SEXIT ;NO.
SRNO: TLCN FL,400000 ;NOT A RES. WORD; HAVE WE ALREADY
JRST SMSCH ;SEARCHED MAIN SYM. TBL. ?
JRST SN1 ; YES; RETURN.
.COMME: MOVE A,SNCHR ;A COMMENT; SKIP TO NEXT ';'
SETZM SNCHR
.COMM1: CAMN A,SEMICV
JRST SCAN
TLNE A,SSPCF+SSPC2F ;SPECIAL TREATMENT ?
PUSHJ P,(A) ;YES.
ILDB A,SCP
MOVE A,CTBL(A)
JRST .COMM1
BUCTBL: REPEAT BUCKNO,<EXP TEMPSY> ;TABLE OF HEADS OF THE
;HASH-CODED BUCKETS IN SYM. TABLE.
NUMBUC: EXP C ;HEAD OF NUMBER TABLE
;THE CHARACTER CONVERSION TABLE -- GOOD BITS FOR EVERYONE !
; GET YOURS WHILE THEY LAST !
OPDEF ILG [XWD DF+SSPCF,SILCH]
CTBL: XWD DF+SSPCF,SENDL
REPEAT 10,<ILG>
0 ; HORIZONTAL TAB.
XWD DF+SSPCF,S.LF ;LINE FEED
XWD DF+SSPCF,S.VT ; VERTICAL TAB
XWD DF+SSPCF,S.FF ;FORM FEED
0 ;CARRIAGE RETURN.
REPEAT 14,<ILG>
XWD DF+SSPCF,SENDL ;↑Z.
;; REPEAT 5,<ILG>
ALTV: XWD DF,. ;ALT MODE (NOW 33 BASE 8) FOR COLGATE
REPEAT 4,<ILG> ; WAS 5, --- FOR COLGATE
0 ;SPACE
REPEAT 7,<ILG>
LPARV: XWD DF,1
RPARV: XWD DF,2
XWD DF+MULBIT,MULOP ; *
PLSV: XWD DF+ADDBIT,ADDOP ; +
COMMAV: XWD DF,COMMOP ; ,
MINV: XWD DF+ADDBIT,SUBOP ; -
DOTV: XWD SNUMF,"." ; .
XWD DF+MULBIT,DIVOP ; /
CTNUM: REPEAT 12,<XWD SDFLG+SNUMF,20+.-CTNUM> ; THE DIGITS.
COLONV: XWD DF,3 ; :
SEMICV: XWD DF,4 ; ;
XWD DF+SSPCF,S.LT ;<
;; XWD DF+RELBIT,EOP ; =
XWD DF,ASNOP ;← AND = DO THE SAME THING. 5/74
XWD DF+RELBIT,GOP ; >
REPEAT 2,<ILG>
CTLTR: REPEAT =5,<XWD 0,41+.-CTLTR> ;THE LETTERS.
41+.-CTLTR ;F
REPEAT =9,<41+.-CTLTR>
XWD FOOBIT,41+.-CTLTR+400000 ;P
REPEAT 4,<41+.-CTLTR>
XWD FOOBIT,41+.-CTLTR
REPEAT 5,<41+.-CTLTR>
LFTBRK: XWD DF,5 ; [
ILG
RGTBRK: XWD DF,6
UARV: XWD DF,EXPOP ; ↑
LARV: XWD DF,ASNOP
REPEAT 35,<ILG>
;;ALTV: XWD DF,. ;ALT MODE. SEE ABOVE
;; REPEAT 2,<ILG>
REPEAT 3,<ILG> ;FOR COLGATE
; END OF CONVERT TABLE.
DEFINE PUT1 (N,Y)
< FOR X IN (Y)
<Q←<SIXBIT /X/>
N*10000000000+(7777777777&(Q/100))
>>
DEFINE PUT2 (Y)
<FOR X IN (Y)
<SIXBIT /X/
>>
RTBL: ;THE RESERVED WORD TABLE.
RT3C: PUT1 (3,END) ;THE 3-LETTER SECTION.
RT4C: PUT1(4,<PLAY>)
RT5C: PUT1(5,<ARRAY>)
RT6C: PUT1 (6,FINIS) ;THE 6-LETTER SECTION.
RT7C: PUT1 (7,<COMME,COMPI>)
RT8C: PUT1 (10,<VARIA,FUNCT,EXTER>) ;VARIABLE
RT10C: PUT1 (12,INSTR) ;
LRTBL←←.-RTBL
RTBL2: 0 ;END
0 ;PLAY.
0
PUT2 (H)
PUT2 (<NT,LE>) ;COMMENT
PUT2 (<BLE,ION,NAL>)
PUT2 (UMENT) ;INSTRUMENT
RF←←DF+RFLG
RTBL3:
ENDV: XWD RF,.
PLAYV: XWD RF,.
ARRV: XWD RF+DECLBIT,DARR
FINV: XWD RF,.
COMV: XWD SSPCF,.COMME
COMPV: XWD RF,.
VARV: XWD RF+DECLBIT,DVRBL
FUNV: XWD RF+DECLBIT,DFUNC ;FUNCTION
EXTV: XWD RF+DECLBIT,EXTD
INSV: XWD RF+DECLBIT,CINS
SRTBL1: 0 ;2
XWD -1,RT3C
XWD -1,RT4C
XWD -1,RT5C
XWD -1,RT6C
XWD -2,RT7C
XWD -3,RT8C
0
XWD -1,RT10C
0
SRSFOO: JUMP 2*LRTBL(B)
;; MORE BITS AND PARAMETERS.
RELBIT←←0
;SIZES OF VARIOUS STACKS AND TABLES:
LOBUFS←←200
LUOTBL←←62
LPLIST←←100
LOSTK←←40
LPA←←62
LRQ←←=75 ;LENGTH OF RUN QUEUE.
;SPECIAL AC DEFINITIONS :
RA←16 ;AC FOR JSA LINKAGE AT RUNTIME.
DEFINE MAKOP1 (X)
<FOR @$ A IN (X)
<A$OP: HALT
>>
MAKOP1 <PW,COMM,L,E,G,EXP,ENDS,WHLS>
;; TEMPORARY AND DEBUGGING ROUTINES:
GO: MOVE P,[IOWD LPLIST,PLIST]
AOSE ONCEFG ;IS THIS FIRST TIME THROUGH ?
JRST GOA ;NO. LEAVE JOBFF AT CURRENT PLACE.
HRLZ 116 ;YES. GET BOTTOM OF SYM. TAB. FROM JOBSYM.
SUB 116 ;ADD LENGTH OF SYM. TAB.
HRLM JOBFF
GOA: HRR JOBFF
HRLM JOBSA
MOVEI FL,0
PUSHJ P,SETUP
GOB: MOVE P,[IOWD LPLIST,PLIST]
MOVE [JSR UUOSER] ;SET UP FOR ERROR UUO.
MOVEM 41
MOVE JOBREL
MOVEM JOBSYM
JRST SCHOWN
ONCEFG: -1
DEFINE ERROR (M)
<XWD 1000,[ASCIZ /M/] >
UDIERR: ERROR (UNDEFINED IDENTIFIER)
SILCH: ERROR (ILLEGAL CHARACTER)
SNUMX1: ERROR(ILLEGAL CHAR. IN NUMBER)
FNDWV: HALT
;USEFUL F4 FUNCTIONS TO HAVE AROUND....
EXTERNAL SIN,COS,EXP,ALOG,SQRT
TEMPSY: EXP TMPS1Z
PUT1 5,OSCIL
XWD UGBIT,.+2
0
JSP RA,@OSCIL ;POINTER DID NOT RESET WITH '1,5,0,1' IN NEXT!!!!
BYTE (6)4,2,2,1,4,0,1;***** JULY 3,71 THIS ENDED '1,5,0,1' ****
TMPS1Z: TMPS1
PUT1 6,ZOSCI
XWD UGBIT,.+3
PUT2 (L)
0
JSP RA,@ZOSCIL
BYTE (6)4,2,2,1,5,0,1
;CHANGE LAST OF ABOVE TO .. 4,0,1 TO MAKE ZOSCIL NOT LIKE COSCIL
TMPS1: EXP TIMESC+1
PUT1 6,TIMES
XWD VRBLBT,TIMESC
PUT2 C
TIMESC: 1.0
EXP SRATE+1
PUT1 5,SRATE
XWD VRBLBT,SRATE
SRATE: 10000.0
EXP NCHNS+1
PUT1 5,NCHNS
XWD VRBLBT,NCHNS
NCHNS: 1
EXP LSBUF+1
PUT1 5,LSBUF
XWD VRBLBT,LSBUF
LSBUF: 1000
EXP TMPS2
PUT1 3,OUT
XWD UGBIT,.+2
0
JSA RA,@OUT
BYTE (6)1,2,0,0
TMPS2: EXP TMPS3
PUT1 4,OUT2
XWD UGBIT,.+2
0
JSA RA,@OUT2
BYTE (6)3,2,2,2,0,0
TMPS3: TMPS3A
PUT1 5,SPEED
XWD VRBLBT,SPEED
SPEED: 1
TMPS3A: TMPS11
PUT1 6,ZINTR
XWD UGBIT,.+3
PUT2 P
JSA RA,IINTRP
JSP RA,@ZINTRP
BYTE (6)5,2,2,5,1,4,0,T
TMPS11: TMNOSA
PUT1 6,VFMUL
XWD UGBIT,.+3
PUT2 T
0
JSP RA,@VFMULT
BYTE (6)3,2,2,1,0,T
; OSCIL IS NOW THE NOSCIL...JMG 7/14/73
; SOMEDAY, IF IT IS EVER USED, SOMEONE COULD CHANGE
; THE NAME OF NOSCA TO OSCA, ETC.
;TMPS12: TMNOSA
; PUT1 6,NOSCI
; XWD UGBIT,.+3
; PUT2 L
; 0
; JSP RA,@NOSCIL
; BYTE (6)4,2,2,1,4,0,1
TMNOSA: TMPS13
PUT1 5,NOSCA
XWD UGBIT,.+2
JSA RA,INOSCA
JSP RA,@NOSCA
BYTE (6)5,2,2,2,1,5,0,T
;TMPS13: TMPS14
; PUT1 10,DISKF
; XWD VRBLBT,DISKFL
; PUT2 LAG
;DISKFL: 0
TMPS13: TMPS24
PUT1 5,INTRP
XWD UGBIT,.+2
JSA RA,IINTRP
JSP RA,@INTRP
BYTE (6)5,2,2,5,1,4,0,T
TMPS24: TMPS14
PUT1 4,READ
XWD UGBIT,.+2
JSP RA,READI
JSP RA,@READ
BYTE (6)6,2,2,1,2,5,5,0,T
TMPS14: TMPS15
PUT1 4,REVX
XWD UGBIT,.+2
JSP RA,REVXI
JSP RA,@REVX
BYTE (6)20,2,2,2,2,2,2,2,2,2,4,4,4,4,4,1,4,0,T
TMPS15: .+3
PUT1 4,OUTA
XWD VRBLBT,OUTA
.+3
PUT1 4,OUTB
XWD VRBLBT,OUTB
.+3
PUT1 4,OUTC
XWD VRBLBT,OUTC
.+4 ;DOPLAY←1=WILL PLAY WHEN WRITING SMPLS ON DSK
PUT1 6,DOPLA
XWD VRBLBT,DOPLAY#
PUT2 Y
.+3
PUT1 4,OUTD
XWD VRBLBT,OUTD
.+4 ;RCDFLG←1 PUTS SAMPLES ON DSK UNDER 'MUSAA','MUSAB',ETC.
PUT1 6,RCDFL
XWD VRBLBT,RCDFLG#
PUT2 G
; .+4
; PUT1 6,DSKFL
; XWD VRBLBT,DSKFLG#
; PUT2 G
.+4
PUT1 6,BIGBI
XWD VRBLBT,BIGBIT#
PUT2 T
.+6
PUT1 5,VALUE
XWD UGBIT,.+2
0
JSP RA,@VALUE
BYTE (6)1,2,0,T
.+5
PUT1 4,RAND
XWD FUNBIT,.+1
PUSHJ P,RAND
BYTE (6)0,T
FRSTB+1
PUT1 =9,FIRST
XWD VRBLBT,FRSTB
PUT2 BAND
FRSTB: 0
.+5
PUT1 5,PRINT
XWD FUNBIT,.+1
JSA RA,FOOPRT
BYTE (6)1,2,0,0
.+3
PUT1 3,RDA
XWD RVBT∨VRBLBT,RDA
.+3
PUT1 3,RDB
XWD RVBT∨VRBLBT,RDB
.+3
PUT1 3,RDC
XWD RVBT∨VRBLBT,RDC
.+3
PUT1 3,RDD
XWD RVBT∨VRBLBT,RDD
TMPSA: EXP TMPS4 ;LINEN.
PUT1 5,LINEN
XWD UGBIT,.+2
JSA RA,LINEN1
JSP RA,@LINEN
; BYTE (6)13,4,4,4,2,2,2,2,1,4,4,4,0,1
BYTE (6)13,4,4,4,2,2,2,2,1,2,4,4,0,1
;NOW YOU MUST RESET PTR IN LINEN
TMPS4: EXP TMPS4A
;TMPS4: EXP TMPS5
PUT1 5,EXPEN
XWD UGBIT,.+2
0
JSP RA,@EXPEN
BYTE (6)4,2,2,1,4,0,1
TMPS4A: EXP TMPS5
PUT1 6,ZEXPE
XWD UGBIT,.+3
PUT2 N
0
JSP RA,@ZEXPEN
BYTE (6)4,2,2,1,4,0,1
TMPS5: EXP TMPS6
PUT1 (4,REV1) ;REV1
XWD UGBIT,.+2
JSP RA,REVI
JSP RA,@REV1
BYTE (6)6,2,2,2,1,5,4,0,1
TMPS6: EXP TMPS7
PUT1 4,REV2
XWD UGBIT,.+2
JSP RA,REVI
JSP RA,@REV2
BYTE (6)6,2,2,2,1,5,4,0,1
TMPS7: EXP TMPS8
PUT1 (7,REVIN) ;REVINIT.
XWD VRBLBT,REVINI
PUT2 IT
REVINI: 0
TMPS8: EXP TMPS9
PUT1 (5,RANDH)
XWD UGBIT,.+2
JSP RA,IRANDH
JSP RA,@RANDH
BYTE (6)4,2,2,4,4,0,1
TMPS9: EXP TMPS10
PUT1 (5,RANDI)
XWD UGBIT,.+2
JSP RA,IRANDI
JSP RA,@RANDI
BYTE (6)5,2,2,4,4,4,0,1
TMPS10: EXP A-1
PUT1 6,COSCI
XWD UGBIT,.+3
PUT2 L
0
; JSP RA,@NOSCIL
JSP RA,@OSCIL
BYTE (6)4,2,2,1,5,0,1
;; HERE ARE SOME WONDERFUL UNIT GENERATORS.
; THIS IS THE OLD OSCIL WHICH DOESN'T LIKE NEG. INCS.
;OSCIL: MOVE INSXR,3(RA)
; FIX INSXR,233000
; TRZE INSXR,777000
; JSP T1,OSCIL1
; MOVE T,@2(RA)
; FMPR T,@(RA)
; SKIPGE T1,@1(RA) ;OSCIL DOESN'T WANT NEG. INC.
; ERROR (NEGATIVE INC. TO OSCIL)
; FADM T1,3(RA)
; JRST 4(RA)
NOSCA: ADDI RA,1
;NOSCIL: MOVE INSXR,3(RA)
OSCIL: MOVE INSXR,3(RA)
FAD INSXR,[0.5]
HRLZI T1,233000
UFA T1,INSXR
; FIX INSXR,233000
; THE ABOVE 2 INST'S REPLACE THE FIX FOR INDEXING
TRZE INSXR,777000
JSP T1,OSCIL1
MOVE T,@2(RA)
FMPR T,@(RA)
MOVE T1,@1(RA)
FADM T1,3(RA)
JRST 4(RA)
OSCIL1: MOVSI (-512.0) ;WRAP AROUND THE POINTER.
JUMPGE INSXR,.+2
MOVNS 0 ;IF NEG. INC., WRAP AROUND OTHER WAY.
FADM 3(RA)
HRLI INSXR,0 ;TO ALLOW ZOSCIL=NOSCIL
JRST (T1)
OUT: 0
MOVE @(RA) ;PICK UP INPUT.
FADM OUTA ;ACCUMULATE INTO OUTPUT ARRAY.
POPJ P, ;RETURN FROM INSTRUMENT.
OUT2: 0
MOVE @(RA)
MOVE 1,0
FMP @1(RA)
FADM OUTA ;
FMP 1,@2(RA)
FADM 1,OUTB
POPJ P,
EXPEN: MOVE INSXR,@1(RA) ;GET INCREMENT.
FADB INSXR,3(RA) ;INCREMENT POINTER.
; FIX INSXR,233000
HRLZI T1,233000
UFA T1,INSXR
; CAIL INSXR,777 ;IF GREATER THAN 512, STICK
TRZE INSXR,777000
EXPEN2: MOVEI INSXR,777 ;AT LAST ELEMENT OF ARRAY.
MOVE T,@2(RA) ;GET ARRAY ELEMENT.
FMPR T,@(RA) ;MULTIPLY BY AMPLITUDE.
JRST 4(RA) ;RETURN.
VFM2: FSBR INSXR,[512.0] ;YOU MUST NOW SET PTR FOR VFMULT!
MOVEM INSXR,@VFMULT
VFMULT: MOVE INSXR,@1(RA) ;GET POINTER INPUT.
CAML INSXR,[512.0]
JRST VFM2
; FIX INSXR,233000
HRLZI T1,233000
UFA T1,INSXR
MOVE T,@2(RA) ;GET INDICATED ELEMENT OF ARRAY.
FMPR T,@(RA) ;MULT. BY AMPLITUDE.
JRST 3(RA)
INOSCA: 0
MOVE T,(RA)
MOVE T1,@-6(T)
MOVEM T1,-2(T)
JRA RA,1(RA)
INTRP: ADDI RA,1
MOVE INSXR,3(RA)
; FIX INSXR,233000
HRLZI T1,233000
UFA T1,INSXR
TRZE INSXR,777000
JSP T1,OSCIL1
MOVE T,@2(RA)
FMPR T,@(RA)
FADR T,@-1(RA)
MOVE T1,1(RA)
FADM T1,3(RA)
JRST 4(RA)
IINTRP: 0
MOVE T,(RA)
MOVE T1,@-5(T)
FSBR T1,@-6(T)
MOVEM T1,@-5(T)
MOVSI T1,(512.0)
FDVR T1,SRATE
FDVR T1,PBASE+2
MOVEM T1,-4(T)
JRA RA,1(RA)
ZEXPEN: SKIPGE INSXR,3(RA) ;ZEXPEN WORKS LIKE ZOSCIL AND EXPEN!
JRST[ ERROR (NEGATIVE INC. TO ZEXPEN)
JSP T1,OSCIL1 ;DO WRAPAROUND ANYWAY
JRST .+1] ;LET THE LOSER CONTINUE
; IT TAKES THESE 4 INST'S TO DO A GOOD FIX FOR FURTHER USE
; FIX INSXR,233000
HRLZI T1,233000
UFA T1,INSXR
JUMPE INSXR,.+2
TLC INSXR,233000
CAIL INSXR,777 ;IF GREATER THAN 511, STICK
JRST EXPEN2 ;AT LAST ELEMENT (WE WON'T NEED TO INTERPOLATE)
MOVE T,@2(RA) ;PICK UP FIRST ELEMENT
move insxr ;SAVE INDEX
move t1,t ;COPY FIRST ELEMENT
addi insxr,1 ;NO, INCREMENT INDEX
fsbr t1,@2(ra) ;GET DWFFERENCE IN VALUE I
fsc 233 ;(FLOAT THE INDEX)
fsb 3(ra) ;GET DIFFERENCE IN INDEX INTO 0
fmpr t1,0 ;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
fadr t,t1 ;IS ADDED TO THE FIRST ELEMENT
FMPR T,@(RA) ;SCALED BY AMPLITUDE
MOVE T1,@1(RA) ;UPDATE SUM OF INCREMENTS
FADM T1,3(RA)
JRST 4(RA)
ZINTRP: ADDI RA,1 ;AN INTERPOLATING INTRP!
MOVE INSXR,3(RA)
; FIX INSXR,233000
HRLZI T1,233000
UFA T1,INSXR
JUMPE INSXR,.+2
TLC INSXR,233000
TRZE INSXR,777000 ;DID WE RUN OVER?
JSP T1,OSCIL1 ;YES, DO WRAPAROUND (BUT IT REALLY SHOULDN'T!)
MOVE T,@2(RA) ;PICK UP FIRST ELEMENT
move insxr ;SAVE INDEX
move t1,t ;COPY FIRST ELEMENT
cain insxr,777 ;ARE WE AT THE LAST ELEMENT
tdza insxr,insxr ;YES, SET INDEX TO ZERO AND SKIP
addi insxr,1 ;NO, INCREMENT INDEX
fsbr t1,@2(ra) ;GET DIFFERENCE IN VALUE I
fsc 233 ;(FLOAT THE INDEX)
fsb 3(ra) ;GET DIFFERENCE IN INDEX INTO 0
fmpr t1,0 ;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
fadr t,t1 ;IS ADDED TO THE FIRST ELEMENT
MOVE @(RA) ;GET SECOND VALUE
FSBR @-1(RA) ;SUBTRACT THE FIRST
FMPR T,0 ;MULIPLY BY DIFFENCE BETWEEN TWO VALUES
FADR T,@-1(RA) ;AND ADD TO THE FIRST VALUE
MOVE T1,1(RA) ;UPDATE SUM OF INCREMENTS
FADM T1,3(RA)
JRST 4(RA)
READ: AOS INSXR,4(RA)
CAML INSXR,5(RA)
JRST READ1
MOVEI T,0
LCS2: MOVE @2(RA)
MOVEM RDA(T)
ADDI T,1
CAML T,3(RA)
JRST 7(RA)
AOS INSXR,4(RA)
JRST LCS2
READ1: MOVE 2(RA)
MOVEM LCS+3
SUBI 1
HRRZM LCS+4
LCS: JSA 16,READIN
0
0
0
0
[-1]
SETZB INSXR,4(RA)
JRST READ+3
READI: MOVE T,(RA)
MOVE T2,@-4(T)
FIX T2,233000
MOVEM T2,-4(T)
MOVE T2,-7(T)
MOVEM T2,LCS1+1
MOVE T2,-6(T)
MOVEM T2,LCS1+2
MOVE T1,-5(T)
MOVE T2, -1(T1)
MOVEM T2,-2(T)
SETOM -3(T)
MOVEM T1,LCS1+3
LCS1: JSA RA,READIN
0
0
0
T2
[0]
JRST 1(RA)
ZOSCIL: MOVE INSXR,3(RA) ;ZOSCIL WORKS LIKE COSCIL AND NOSCIL!
; FIX INSXR,233000
HRLZI T1,233000
UFA T1,INSXR
JUMPE INSXR,.+2
TLC INSXR,233000
TRZE INSXR,777000
JSP T1,OSCIL1
MOVE T,@2(RA)
move insxr
move t1,t
cain insxr,777
tdza insxr,insxr
addi insxr,1
fsbr t1,@2(ra)
fsc 233
fsb 3(ra)
fmpr t1,0
fadr t,t1
FMPR T,@(RA)
MOVE T1,@1(RA)
FADM T1,3(RA)
JRST 4(RA)
;; REVERBERATION UNIT GENERATORS.
; REV1 IS THE SIMPLE FED-BACK DELAY LOOP, OR 'COMB FILTER'.
REV1: AOS INSXR,4(RA) ;INCREMENT OUTPUT PTR.
CAML INSXR,5(RA) ;IS IT TIME TO WRAP AROUND ?
SETZB INSXR,4(RA) ;YES.
MOVE 1,@3(RA) ;GET OUTPUT OF DELAY LINE.
MOVE 2,1 ;LEAVE IN 1 AS FINAL OUTPUT.
FMPR 2,@2(RA) ;MULTIPLY BY FEEDBACK GAIN.
;REVA: MOVE @1(RA) ;GET DELAY TIME, T.
; FIX 233000
; ADD INSXR,0 ;MOVE PTR. AROUND TO INPUT END.
; CAML INSXR,5(RA) ;PROBABLY HAVE TO WRAP AROUND..
; SUB INSXR,5(RA) ;YUP. SUBTRACT LENGTH OF DELAY ARRAY.
; THE ABOVE 5 INSTRUCTIONS ALLOW A DYNAMICALLY CONTROLLED
; DELAY TIME IN REVERB. TO INSTITUTE, CHANGE THE LOC. OF
; 'REVA:' BACK TO ABOVE AND DE-COMMENT. THE PRESENT REVERB
; ASSUMES THAT THE ARRAY LENGTH IS THE DELAY, SO THE ARGU-
; MENT IN THE UG IS IGNORED... JMG 7/14/73
REVA: FADR 2,@(RA) ;ADD IN THE INPUT SAMPLE.
JFCL 1,[SETZB 2,1 ;FLOAT. UNDER FLOW
SETOM FXUFLG#
JRST .+1] ;THESE WERE ON JC,MUS. WHY???
MOVEM 2,@3(RA) ;PLACE IN INPUT OF DELAY LINE.
JRST 6(RA) ;RETURN.
;REV2 IS THE ALL-PASS REVERBERATOR.
REV2: AOS INSXR,4(RA) ;CALC. PTR. AS IN REV1.
CAML INSXR,5(RA)
SETZB INSXR,4(RA)
;; MOVN 1,@3(RA) ;GET NEGATIVE OF OUTPUT OF DELAY.
;; MOVN 0,@2(RA) ;ALSO NEGATIVE OF GAIN, G.
;; FMPR 1,0 ;FORM GAIN*OUTPUT
;; MOVE 2,1 ;(NOTE THIS IS POSITIVE).
;; FMPR 1,0 ;FORM -G↑2 * OUTPUT.
;; FADR 1,@3(RA) ;(1-G↑2) * OUTPUT.
;; FMPR 0,@(RA) ;FORM -G * INPUT.
;; FADR 1,0 ;FINAL OUTPUT IS -G*IN +(1-G↑2)*OUT.
;; JRST REVA ;FROM HERE ON, SAME AS REV1.
MOVE 2,@2(RA) ;GET GAIN, G
FMPR 2,@(RA) ;MULTIPLY BY INPUT
FADR 2,@3(RA) ;ADD IN OUTPUT OF DELAY
MOVN 1,2 ;TAKE -(OUTPUT+G+IN)
FMPR 1,@2(RA) ;SCALE BY GAIN
FADR 1,@(RA) ;ADD INPUT
JFCL 1,[SETZB 2,1 ;FLOATING UNDERFLOW
SETOM FXUFLG#
JRST .+1]
MOVEM 1,@3(RA) ;NEW DELAY INPUT
JRST 6(RA) ;RETURN WITH ANSWER IN 2
; NEW REV. 1 LESS MULT. A.MOORER, 5/74
; THIS IS THE I-TIME CODE FOR REV1 AND REV2.
REVI: HRRZ T1,(RA) ;GET PTR. TO END OF REV PARAMS.
MOVNI INSXR,1 ;INSXR←-1
HRRZ @-4(T1) ;GET -1ST ELEMENT OF ARRAY (THE LENGTH)
MOVEM -2(T1) ;PLACE IN THE SECOND DUMMY PARAM.
SKIPN REVINI ;SHOULD WE INIT. THE DELAY ARRAY ?
JRST 1(RA) ;NO.
SETZM -3(T1) ;YES. FIRST CLEAR THE POINTER LOC.
HRRZ T,-4(T1) ;GET PTR. TO ARRAY.
REVI2: ADDI -1(T) ; 0 NOW POINTS TO TOP OF ARRAY.
HRL T,T
SETZM (T) ;CLEAR FIRST ELEMENT OF ARRAY.
ADDI T,1 ;FORM BLT POINTER.
BLT T,@0 ;CLEAR REST OF ARRAY.
JRST 1(RA)
;; MORE GENERATORS.
LINEN: MOVE INSXR,11(RA) ;GET INCREMENT.
; FADB INSXR,10(RA) ;ADD TO POINTER.
FADB INSXR,@10(RA) ;NOW YOU MUST RESET PTR
LINEN4: CAML INSXR,12(RA) ;ARE WE PAST END OF SECTION ?
JRST LINEN2 ;YES.
FIX INSXR,233000
MOVE T,@3(RA) ;AMPLITUDE.
FMPR T,@7(RA) ;MULT. BY ARRAY ELEMENT.
JRST 13(RA) ;RETURN.
LINEN2: MOVE T,12(RA) ;PICK UP CURRENT LIMIT.
FIX T,242000
CAIL T,3 ;END OF ARRAY ?
JRST LINEN3 ;YES.
HRLI T,RA ;PREPARE FOR INDEXING...
MOVE @T ;PICK UP NEXT INCREMENT.
MOVEM 11(RA) ;PUT AWAY.
MOVSI (128.0)
FADM 12(RA) ;INCREMENT LIMIT TO NEXT VALUE.
JRST LINEN4
LINEN3: MOVEI 14(RA) ;FAKE UP A PARAMETER FOR LINEN1.
MOVEM .+2
JSA RA,LINEN1 ;RE-INITIALIZE THE GENERATOR.
0 ;
; SETZM 10(RA) ;RESET PTR.
SETZM @10(RA) ;NOW YOU MUST RESET PTR
SETZM 11(RA) ;AND INCREMENT.
SETZM 12(RA) ;...AND LIMIT.
JRST LINEN
LINEN1: 0 ;THE INITIALIZING CODE FOR LINEN.
MOVE T2,(RA) ;GET POINTER TO END OF PARAMETERS.
MOVE T1,TIMESC ;CALC. 128*(BEATS/SAMPLE)
FDVR T1,SRATE
FSC T1,7
MOVE T,@-10(T2) ;GET RISE TIME IN BEATS.
FDVRM T1,T ;INCREMENT←T1/TIME (=128/(TIME IN SAMPS))
MOVEM T,-14(T2) ;PLACE IN PARAMETER 0.
MOVE T,@-6(T2) ;DURATION OF NOTE IN BEATS...
FSBR T,@-7(T2) ;...MINUS FALL TIME..
FSBR T,@-10(T2) ;...MINUS RISE TIME.
FDVRM T1,T ;CHANGE TO INCREMENT.
MOVEM T,-13(T2) ;PLACE IN PARAMETER 1.
FDVR T1,@-7(T2) ;INCREMENT FOR FALL TIME.
MOVEM T1,-12(T2) ;PLACE IN PARAMETER 2.
JRA RA,1(RA)
VALUE: MOVE T,@(RA) ;DUMMY UNIT GENERATOR... OUTPUT IS
JRST 1(RA) ;SAME AS ITS PARAMETER.
;; RANDOM NUMBER GENERATORS.
RANDH: MOVE @1(RA) ;GET INCREMENT.
FADB 2(RA) ;INCREMENT THE 'POINTER'.
CAML [512.0] ;OVER 512 ?
JRST RNDH2 ;YES. GO GET NEW RANDOM NUMBER.
MOVE T,@(RA) ;NO. GET INPUT ...
FMPR T,3(RA) ;... AND MULT. BY CURRENT RANDOM NO.
JRST 4(RA) ;RETURN.
RNDH2: MOVSI (-512.0) ;CAUSE 'POINTER' TO 'WRAP AROUND'.
FADM 2(RA)
PUSHJ P,RAND ;GET NEW RANDOM NO.
MOVEM T,3(RA) ;MAKE IT THE CURRENT NO.
FMPR T,@(RA) ;MULT. BY INPUT.
JRST 4(RA) ;RETURN.
IRANDI: ;I-TIME CODE FOR RANDI AND RANDH.
IRANDH: PUSHJ P,RAND ;INIT. RANDH.
MOVE T2,(RA) ;GET PTR. TO LAST PARAM..
MOVEM T,-2(T2) ;PUT INITIAL RAND. NO. IN.
JRST 1(RA)
RANDI: MOVE T,2(RA) ;GET CURRENT DELTA..
FADRB T,4(RA) ;ADD TO LAST OUTPUT VALUE...
SOSG 3(RA) ;DECREMENT STEP COUNTER ...
JRST RNDI2 ;IT'S 0, SO GET NEW RANDOM NO.
FMPR T,@(RA) ;NO. MULT BY INPUT.
JRST 5(RA) ;RETURN.
RNDI2: PUSHJ P,RAND ;GET NEXT RANDOM NO.
FSBR T,4(RA) ;FORM DELTA (=NEW - OLD)
MOVSI T1,(512.0)
FDVR T1,@1(RA) ;NO. OF STEPS = 512/(FREQ. INPUT)
FDVR T,T1 ;CHANGE PER STEP =DELTA/NO. OF STEPS
MOVEM T,2(RA) ;STORE CHANGE PER STEP.
FIX T1,233000
MOVEM T1,3(RA) ;PUT IT AWAY.
JRST RANDI ;NOW GO GENERATE FIRST STEP.
RAND: MOVE T,RNDNO1 ;GENERATE A RANDOM NO.
ADD T,RNDNO2
EXCH T,RNDNO2
MOVEM T,RNDNO1
ASH T,-10 ;SMEAR SIGN INTO EXPONENT FIELD..
FSC T,200 ;... AND FLOAT IT IN RANGE -1 TO 1.
POPJ P,
RNDNO1: 756132257563
RNDNO2: 756132257565
PLIST: BLOCK LPLIST
OSTK: BLOCK LOSTK
RQ1: BLOCK LRQ ;THE RUN QUEUE, CLOUMN ONE.
RQ2: BLOCK LRQ ;COLUMN TWO.
PATCH: BLOCK 100
IARR1: ;; HERE BEGINS AN AREA WHICH IS ZEROED DURING
; INITIALIZATION OF EACH COMPILATION.
UOTBL: BLOCK LUOTBL
ACS:
RACS: BLOCK 20
IACS: BLOCK 20
UOPTR: -1
IARR2:
PBASE: BLOCK LPA
OUTA: 0 ;CHANNEL A OUTPUT SAMPLE ACCUMULATED HERE.
OUTB: 0 ;CHANNEL B.
OUTC: 0 ;CHANNEL C.
OUTD: 0 ;CHANNEL D.
RDA: 0
RDB: 0
RDC: 0
RDD: 0
IARR3:
VLOC: 0
ILOC: 0
RLOC: 0
DSKMAX: =76*2000*17
;; THIS IS THE MULTIPLE-FEEDBACK REVERBERATOR.
;; ITS DELAY TIMES MUST NOT BE R-TIME VARIABLES.
REVX: SOSGE INSXR,15(RA) ; ADVANCE PTR. TO 4TH TAP.
JSP T1,REVX1 ;TIME TO WRAP AROUND....
MOVE T,@16(RA) ;GET DELAY ARRAY OUTPUT FROM 4TH TAP..
FMP T,@10(RA) ;MULT. BY GAIN NO. 4
SOSGE INSXR,14(RA) ;NOW PTR. TO 3RD TAP.
JSP T1,REVX1
MOVE @16(RA) ;... 3RD TAP DELAY OUTPUT...
FMP @6(RA) ;...3RD GAIN...
FAD T,0 ;ACCUMULATE SUM IN T.
SOSGE INSXR,13(RA) ;2ND TAP PTR.
JSP T1,REVX1 ;THIS COULD GET BORING.
MOVE @16(RA)
FMP @4(RA) ;GAIN 2.
FAD T,0
SOSGE INSXR,12(RA) ;ONE MORE CHORUS.
JSP T1,REVX1
MOVE @16(RA)
FMP @2(RA) ;GAIN 1.
FADB T,0 ;T NOW HAS FINAL OUTPUT(=SUM OF
; TAPS * GAINS).
FAD @(RA) ;ADD OUTPUT TO INPUT ..
SOSGE INSXR,11(RA) ;.. GET PTR. TO INPUT OF DELAY..
JSP T1,REVX1
MOVEM @16(RA) ;AND PUT IT THERE.
JRST 20(RA) ;WOULD YOU BELIEVE 20 PARAMETERS ??!
REVX1: ADD INSXR,17(RA) ;A PTR. HAS UNDERFLOWED; ADD
MOVEM INSXR,@-2(T1) ; LENGTH OF ARRAY TO IT TO WRAP
JRST (T1) ;IT AROUND (AND STORE UPDATED VERSION).
REVXI: MOVE T1,(RA) ;INITIALIZING FOR REVX.. GET PTR. TO PARAMMS.
MOVNI INSXR,1
MOVE @-3(T1) ;GET -1ST ELEMENT OF ARRAY (= ITS LENGTH).
MOVEM -2(T1) ;STORE IN LAST DUMMY PARAM.
SKIPE REVINI ;IF WE ARE INITIALIZING REVERBERATORS,
SETZM -10(T1) ;RESET INPUT PTR. OF DELAY TO BOTTOM OF ARRAY.
MOVSI T,-4 ;NOW WE SET UP THE FOUR DELAY OUTPUT TAP
HRRI T,-7(T1) ;PTRS. THE RIGHT DISTANCE BEHIND THE INPUT PTR.
MOVEI T2,-20(T1) ;
REVXI2: MOVE @(T2) ;PICK UP DELAY TIME (IN SAMPLES).
FIX 233000
ADD -10(T1) ;ADD TO INPUT PTR. POSITION.
CAML -2(T1) ;WRAP AROUND ?
SUB -2(T1) ;YES. SUB. LENGTH OF ARRAY.
MOVEM (T) ;PLACE PTR. IN RIGHT DUMMY PARAM.
ADDI T2,2 ;INC. T2 TO POINT AT NEXT DELAY TIME PARAM.
AOBJN T,REVXI2 ;LOOP TO GET ALL 4 DELAY TAPS.
SKIPN REVINIT ;ARE WE INITIALIZING REVERBERATORS ?
JRST 1(RA) ;NO. RETURN.
MOVE -2(T1) ;YES GET LENGTH OF ARRAY.
HRRZ T,-3(T1) ;GET BASE OF ARRAY.
JRST REVI2 ;GO ZERO ARRAY (SEE REV1 AND REV2 PAGE).
; ***** COMPX BEGINS HERE **** ROUTINES TO EMIT CODE AND STUFF TO OUTPUT BUFFERS.
EMDV: SETZB A,B ;EMIT A DUMMY VARIABLE (TO RESERVE
; SPACE IN THE VARIABLES AREA).
EMVCDI: AOS VLOC
EMVCD: MOVEI T1,2 ;EMIT TO VARIABLE BUFFER.
JRST ECD
EMIABS: TDZA B,B ;EMIT TO I-TIME BUF. , NO RELOC.
EMCDI: AOSA RLOC ;SKIP INSTRUCTIONS WIN BIG.
EMICDI: AOSA ILOC ; SEE THE HAPPY INTERLEAVED CODE !
EMCD: TDZA T1,T1 ;EMIT TO RUNTIME BUFFER.
EMICD: MOVEI T1,1 ;EMIT TO INITIALIZE TIME BUFFER.
ECD:
IDPB A,EMPTR(T1) ;EMIT THE WORD.
IDPB B,RELPTR(T1) ;ALSO ITS RELOCATION BITS.
AOSGE BUFCNT(T1) ;IS BUFFER FULL ?
POPJ P, ;NO. RETURN.
GBUF: ; BUFFER IS FULL; GET A NEW ONE.
MOVNI T,LOBUFS ;LENGTH OF A BUFFER.
PUSHJ P,GFS ;GET SOME FREE STORAGE(WHILE IT LASTS!)
HRLI T,400 ;MAKE BYTE PTR.
MOVEM T,RELPTR(T1) ;PTR. FOR RELOCATION BITS.
MOVEI T2,LOBUFS/12+2(T) ;LEAVE ROOM FOR REL. BITS
HRRM T2,EMPTR(T1) ;DATA PTR.
HRRZM T,@OBPTR(T1) ;FIX UP FORWARD LINKS.
HRRZM T,OBPTR(T1)
SETZM @OBPTR(T1)
MOVNI LOBUFS-LOBUFS/12-3
MOVEM BUFCNT(T1) ;SET UP WORD COUNT.
POPJ P,
EMPTR: POINT 36,0,35 ;DATA OUTPUT POINTERS.
EMIPTR: POINT 36,0,35
EMVPTR: POINT 36,0,35
RELPTR: POINT 4,0 ;RELOC. BITS PTRS.
RELIPT: POINT 4,0
RELVPT: POINT 4,0
OBPTR: BLOCK 3 ;PTR. TO FIRST WORD OF CURRENT BUFFER FOR
; USE IN FIXING UP FORWARD LINKS.
BUFCNT: BLOCK 3 ;WORD COUNTS FOR BUFFERS.
FCBUF: 0 ;PTR. TO FIRST BUFFER IN EACH CHAIN.
FICBUF: 0
FVCBUF: 0
GFS: ADD T,JOBSYM ;DECREMENT BOTTOM OF FREE STORAGE.
HRRZ JOBFF
CAIL (T) ;ROOM LEFT ?
ERROR (STORAGE FULL) ;NO.
MOVEM T,JOBSYM
POPJ P,
;THIS HERE IS THE COMPILER !
; RECURSIVE EXPRESSION ANALYZER.
SEXPR: PUSHJ P,SCAN
EXPR: PUSHJ P,TERM ;<EXPR> = <TERM> ! <TERM><ADDOP><EXPR>
EXPR1: TLNE A,DF ;A DELIMITER NEXT ?
TLNN A,ADDBIT ;YES. AN ADD OR SUBTRACT OP. ?
POPJ P, ;NO.
PUSH P,A ;YES. LOOK FOR ANOTHER TERM.
PUSHJ P,STERM ;THIS IS ITERATIVE INSTEAD OF
; RECURSIVE IN ORDER TO PROCESS FROM LEFT TO
EXCH A,(P) ; RIGHT.
PUSHJ P,(A) ;CALL APPROPRIATE GENERATOR.
POP P,A
JRST EXPR1
STERM: PUSHJ P,SCANV
TERM: PUSHJ P,FACTOR ;<TERM>=<FACTOR>!<FACTOR><MULOP><FACT.>
TERM1: TLNE A,DF ;A DELIMITER NEXT ?
TLNN A,MULBIT ;YES. A MULTIPLY OR DIVIDE OP ?
POPJ P, ;NO.
PUSH P,A
PUSHJ P,SFACTOR
EXCH A,(P)
PUSHJ P,(A)
POP P,A
JRST TERM1
SFACTOR:PUSHJ P,SCANV
FACTOR: JRST PRIMARY ;GOOD ENOUGH FOR NOW ...
SPRIM: PUSHJ P,SCAN
PRIMARY:
JUMPE A,UDIERR ;STILL UNDEFINED ?
TLNN A,DF ;IS IT A SPECIAL CHAR. ?
JRST PRIM3 ;NO.
PRIM2: CAMN A,MINV ;UNARY MINUS ?
JRST PRUMIN ;YES.
CAME A,LPARV ;NO. IT BETTER BE A (.
ERROR (ILLEGAL PRIMARY.)
PUSHJ P,SEXPR ;SCAN AN EXPRESSION.
CAME A,RPARV ;LOOK FOR MATCHING PAREN.
ERROR (MISSING RIGHT PAREN.)
JRST SCAN ;SCAN AND RETURN.
PRUMIN: PUSHJ P,SPRIM ;UNARY MINUS; SCAN A PRIMARY.
PUSH P,A
PUSHJ P,UMGEN ;CALL GENERATOR.
JRST POPAJ ;RESTORE A AND RETURN.
PRIM3: TLNN A,FUNBIT ;THE NAME OF A FUNCTION ?
JRST SVRBL ;NO.
PRFUN: PUSHJ P,FUNCAL ;COMPILE THE FUNCTION CALL.
PUSHJ P,MRKAC0 ;MARK AC0 FULL (VALUE OF FUNCTION).
JRST SCAN ;RETURN.
SVRBL: TLNN A,VRBLBT!SWVBT!NUMFLG!FOOBIT ;SHOULD BE A VARIABLE,ARRAY NAME,NUMBER OR FOO SYM.
ERROR (ILLEGAL PRIMARY)
TLNE A,VRBLBT!NUMFLG!FOOBIT ;IS IT AN ARRAY NAME ?
JRST SVRBL2 ;NO.
HRR A,(A) ;YES. GET R. HALF OF GOOD BITS.
SUBI A,2 ;MAKE IT POINT TO ARRAY[-2].
SVRBL2: PUSH OSP,A ;MAY BE AN ASN. STMT....
TLNE A,NUMFLG+SWVBT ;IF IT IS A NUMBER, IT CAN'T BE
JRST SCAN ;LEFT PART OF ASN. STMT.
SVRBL1: PUSHJ P,SCAN ;GET LEFT ARROW,IF ANY.
CAME A,LARV ;IT IS ONE, ISN'T IT ?
POPJ P, ;NOPE. JUST A GARDEN VARIETY VARIABLE.
PUSHJ P,ASTMT1 ;YES. COMPILE IT.
PUSHJ P,MRKAC ;SINCE ITS A PRIMARY, REMEMBER ITS
JRST POPAJ ;VALUE, THEN RETURN.
ASTMT1: ;; COMPILE ASSIGNMENT STMT...
PUSHJ P,SEXPR ;COMPILE RIGHT PART OF STMT.
EXCH A,(P) ;SAVE 'A' UNDERNEATH RETURN ADR.
PUSH P,A
JRST ASNGEN ;GENERATE THE STORE.
; PROCESS A FUNCTION CALL.
FUNCAL: PUSH P,RLOC ;SAVE R-TIME CODE LOC. CTR.
HRRZ B,(A) ;GET PTR. TO PARAMETER DESCRIPTORS.
PUSH P,B ;PTR. TO SYMTABLE ENTRY.
PUSH OSP,(B) ;PLACE CALLING INSTR. ON OPND. STK.
PUSH P,[POINT 6,0,35] ;MAKE A PTR. TO THE BYTES
HRRM B,(P) ; OF THE PARAMETER DESRIPTION.
ILDB T,(P) ;GET PARAMTER COUNT.
PUSH P,T
JUMPE T,FNOPR ;IF NO PARAMS., CALL GENERATOR.
PUSHJ P,SCAN ;SWALLOW LEFT PAREN.
CAME A,LPARV ;I HATE PEOPLE WHO DO THIS.
ERROR (MISSING LEFT PAREN.)
PUSHJ P,SCAN ;SCAN FIRST PARAM.
FUNC4: PUSH P,A
FUNC1: ILDB T,-2(P) ;GET NEXT PARAM. DESCRIPTOR.
CAIN T,FDPARB ;IS IT A DUMMY PARAM. ?
JRST FDPAR ;YES.
CAIN T,FDPARC ;OR A TYPE 2 DUMMY ?
JRST FDPAR2 ;YES.
POP P,A ;NO.
JUMPE T,FLPAR ;IF =0,NO MORE PARAMS.
CAME A,RPARV ;NO PARENTHESES OR COMMAS HERE, PLEASE.
CAMN A,COMMAV
ERROR (MISSING PARAMETER)
CAIN T,FAOPAR ;MUST THIS PARAM. BE AN ARRAY NAME ?
JRST FAPAR ;YES.
PUSHJ P,EXPR ;NO, LET IT BE AN EXPRESSION.
FUNC2: CAMN A,COMMAV ;IS IT A COMMA ?
FUNC3: PUSHJ P,SCAN ;YES, ALTHOUGH WE DONT REALLY CARE.
JRST FUNC4
FLPAR: CAME A,RPARV ;LAST PARAM. IS FOLLOWED BY ).
ERROR (MISSING RIGHT PAREN.) ; ... OR ELSE.
FNOPR: PUSHJ P,GFUNC ;CALL GENERATORS.
ILDB A,-1(P) ;GET NO. OF AC CONTAINING RESULT.
SUB P,[XWD 4,4] ;FORGET ABOUT THINGS IN STACK.
POPJ P,
FAPAR: ;PARAMETER IS NAME OF FUNCTION ARRAY.
PUSHJ P,GAPAR ;CALL GENERATOR.
PUSHJ P,SCAN
JRST FUNC2
FDPAR: PUSHJ P,GDPAR ;GENERATE A DUMMY PARAM.
JRST FUNC1
FDPAR2: PUSH OSP,[0] ;EMIT A DUMMY PARAM., BUT WITHOUT
JRST FUNC1 ;ANY INSTR. TO ZERO IT AT I-TIME.
; HERE ARE THE GLORIOUS, SUPER-INTELLIGENT, SCHIZOPHRENIC
; CODE GENERATORS. LOOK UPON THEM AND BE AMAZED.
MULGEN: SKIPA T,[FMP] ;GENERATE A MULTIPLY.
ADDGEN: MOVSI T,(<FAD>) ;SEE THE STUPID FAIL !
PUSH P,T
PUSHJ P,GGET1 ;GET ONE OPERAND IN AN AC.
GEN1: POP P,C ;RECOVER THE OPCODE.
GEN2: PUSHJ P,EMINST ;EMIT THE INSTRUCTION.
JRST MRKAC ;MARK THE AC FULL AND RETURN.
DIVGEN: SKIPA T,[FDV] ;GENERATE A DIVIDE ...
SUBGEN: MOVSI T,(<FSB>) ; .. OR A SUBTRACT.
PUSH P,T
PUSHJ P,GGET2 ;GET FIRST OPERAND IN AN AC.
JRST GEN1
UMGEN: PUSHJ P,GMURKA ;UNARY MINUS. GET THE OPERAND.
PUSH P,E
PUSHJ P,GETAC ;GET A FREE AC.
POP P,B ;BRING BACK AC ADDRESS.
MOVSI C,(<MOVN>) ;EMIT GOOD INSTRUCTION.
JRST GEN2
MULOP←←MULGEN
ADDOP←←ADDGEN
SUBOP←←SUBGEN
DIVOP←←DIVGEN
ASNGEN: ;COMPILE STORE FOR ASIGNMENT STMT.
ASNOP: PUSH P,-1(OSP) ;SAVE PTR. TO GOOD BITS OF VRBL.
PUSHJ P,GMURK ;GET EXPR. AND LEFT-PART VARIABLE.
EXCH D,E ;GET THEM IN RIGHT ORDER.
PUSHJ P,GG2 ;GET EXPR. IN AN AC.
POP P,T ;RECOVER PTR. TO VRBL. GOOD BITS WORD...
MOVE H
LSH =35-PRVBT ;PUT R-TIME FLAG IN RIGHT POSITION...
TLNN B,GPBIT ;IF NOT A P-SYMBOL,
ORM (T) ;SET R-TIME BIT CORRECTLY.
MOVSI C,(<MOVEM>) ;EMIT A MOVEM TO STORE VALUE OF EXPR.
JRST EMINST
; HA! I BET YOU THOUGHT WE WERE DONE, DIDN'T YOU ?
; WELL, HERE BEGINS AN INFINITE REGRESSION OF
; CLEVER ,GRUBBY ROUTINES WHICH DO THE
; DIRTY WORK FOR THE GENERATORS.
; GPONDER REMOVES THE TOP THING FROM THE OPERAND STACK,
; LOVINGLY PATS ITS MAGIC BITS INTO STANDARD FORMAT,
; AND SETS A FLAG INDICATING WHETHER IT IS AN
; R-TIME VARIABLE OR NOT.
GPONDER: MOVEI H,0 ;RESET R-TIME VARIABLE FLAG.
GPOND1: POP OSP,T ;GET TOP THING.
TLNE T,FOOBIT ;IS IT A FOO-SYMBOL?
JRST GPFOO ;YES.
TLNE T,NUMFLG ;A NUMBER ?
POPJ P, ;YES. WE ARE DONE.
TLNE T,SRACBT+RVBT ;AN R-TIME AC OR VARIABLE ?
MOVEI H,1 ;YES. SET R-TIME FLAG.
TLNE T,SRACBT ;AN R-TIME AC ?
SETZM RACS(T) ;YES. MARK IT FREE.
TLNE T,SIACBT ;(SAME FOR I-TIME AC).
SETZM IACS(T)
TLNE T,VRBLBT ;A VARIABLE ?
HRR T,(T) ;YES. GET RT. HALF GOOD BITS.
POPJ P,
GPFOO: TRZE T,400000 ;IS IT A P-SYMBOL?
JRST GPONP ;YES.
GPONU: MOVEI H,1 ;REFERS TO A UINIT GENERATOR; SET FLG.
HRRZS T ;GET NO. OF UNIT GEN.
CAMLE T,UOPTR ;NO FORWARD REFERENCES TO UNIT GEN.
ERROR (FORWARD REF. TO UNIT GENERATOR)
MOVE T,UOTBL(T) ;GET ADDRESS OF ITS OUTPUT CELL.
POPJ P,
GPONP:
ADDI T,PBASE ;BASE OF PARAM. ARRAY.
HRLI T,GPBIT ;MARK AS P-SYMBOL.
POPJ P,
; GMURK CLEVERLY GPONDERS THE TOP TWO OPERANDS,
; AND IF ONE OF THEM IS AN R-TIME VARIABLE
; AND THE OTHER IS AN I-TIME AC OR A P-SYMBOL, IT STORES
; THE LATTER WHERE IT WILL BE SAFE UNTIL R-TIME.
GMURKA: MOVEI H,0
GMURK1: TDZA T,T ;PROCESS ONLY TOP STACK ELEMENT.
GMURK: PUSHJ P,GPONDER ;GPONDER THE FIRST OPERAND.
PUSH P,T ;SAVE IT
PUSHJ P,GPOND1 ;NOW THE SECOND.
POP P,D ;PUT THEM BOTH IN SOME SAFE ACCUMULATORS.
MOVE E,T
SKIPN H ;IS EITHER ONE AN R-TIME VARIABLE ?
POPJ P, ;NO.
TLNE E,SIACBT+GPBIT ;AN I-TIME AC OR A P-SYMBOL ?
JRST GM2 ;YES.
TLNN D,SIACBT+GPBIT ;HOW ABOUT THIS ONE ?
POPJ P, ;HE ISN'T, EITHER. RETURN.
SKIPA F,[EXP D] ;BAGBITING MACROX.
GM2: MOVEI F,E ;SEE THE TWO HEADED MONSTER.
MOVE A,(F) ;GET THE RELEVANT THING.
TLNE A,GPBIT ;A P-SYMBOL, OR AN I-TIME AC ?
JRST GM3 ; A P-SYMBOL.
MOVE B,VLOC ;STORE IT IN VARIABLE AREA.
GM3B: MOVEM B,(F) ;CHANGE THE OPERAND INDICATOR.
MOVE C,[MOVEM EMICDI] ;EMIT THE STORE INSTRUCTION.
PUSHJ P,EMINST
JRST EMDV ;MAKE APLACE IN THE VARIABLES FOR IT.
GM3: SKIPN T1,(A) ;HAS THE PARAMETER ALREADY BEEN
JRST GM3A ; PUT IN VAR. AREA ?
MOVEM T1,(F) ;YES. CHANGE POINTER.
POPJ P,
GM3A: PUSHJ P,GETIAC ;FIND FREE I-TIME AC.
MOVE B,(F)
MOVE T,VLOC ;GET VAR. LOC. CTR.
TLO T,GPBIT
MOVEM T,(B) ;ENTER IN PARAMTER TABLE.
MOVE C,[MOVE EMICDI] ;EMIT INSTR. TO
PUSHJ P,EMINST ;PICK UP THE PARAMETER.
MOVE B,VLOC ;GET LOC. AGAIN...
TLO B,GPBIT ;MARK AS A P-SYMBOL.
JRST GM3B ;NOW STORE THE PARAMETER IN VAR. AREA.
; STILL MORE KLUGES. PAUSE TO GET YOUR BREATH NOW.
;GGET1 ARRANGES TO HAVE ONE OF THE TOP TWO OPERANDS
; IN AN AC. IT RETURNS IN 'A' THE ADDRESS OF THAT AC, AND
; IN 'B' THE ADDRESS OF THE OTHER OPERAND, WITH RELOCATION
; BITS IN LEFT HALF.
GGET1: PUSHJ P,GMURK ;PROCESS TOP TWO OPERANDS.
TLNN D,SIACBT+SRACBT ;IS FIRST ONE IN AN AC ?
JRST GG2 ;NO.
MOVE A,D ;YES. WE ARE DONE.
MOVE B,E
POPJ P,
GGET2: PUSHJ P,GMURK ;GGET2 GETS SECOND OPERAND IN AN AC.
GG2: MOVE A,E ;PUT OPERAND IN A.
TLNE A,SIACBT+SRACBT ;IS IT ALREADY IN AN AC ?
JRST GL2A ;YES. WIN BIG.
TLNE D,SIACBT+SRACBT ;HOW ABOUT OTHER OP. ?
SETOM @ACTB3(H) ;AN AC... MARK IT FULL TEMPORARILY.
PUSHJ P,GETAC ;GET A FREE AC OF THE APPROPRIATE KIND.
MOVE B,E ;LOAD SECOND OPERAND INTO IT.
MOVSI C,(<MOVE>) ;EMIT LOAD INSTR.
PUSHJ P,EMINST
TLNE D,SIACBT+SRACBT ;IF OTHER OP. IS IN AN AC,
SETZM @ACTB3(H) ;MARK IT FREE NOW.
GL2A: MOVE B,D ;PUT OTHER OP IN B.
POPJ P,
; EMINST IS THE INSTRUCTION EMITTING ROUTINE. CALL IT
; WITH AC IN A,THE ADDRESS (+ RELOC. BITS) IN B, AND
; OPCODE IN C. IF RIGHT HALF OF C IS NON-ZERO, IT IS THE
; ADDRESS OF THE APPROPRIATE BUFFER EMITTING ROUTINE;
; OTHERWISE THE INSTR. IS PLACED IN THE I-TIME
; OR R-TIME BUFFERS ACCORDING TO THE STATE OF THE FLAG IN H.
EMINST: PUSH P,A ;SAVE IT.
HLL A,C ;ASSEMBLE INSTRUCTION IN A.
DPB A,[POINT 4,A,12] ;PUT IN AC FIELD.
HRR A,B ;ALSO ADDRESS.
TLZE B,FPARBT ;IS ADDR. A FORMAL PARAMETER ?
TLO A,20+RA ;YES. ADD INDIRECT BIT AND INDEX.
HLRZS B ;PUT RELOC. BITS FOR ADDRESS IN RIGHT HALF OF B.
PUSH P,[EXP EMIN2] ;RETURN ADDRESS.
TRNE C,-1 ;RH OF C =0 ?
JRST (C) ;NO.
JRST @EMITB(H)
POPAJ: ;A USEFUL ENTRY POINT.
EMIN2: POP P,A
POPJ P,
EMITB: EMICDI
EMCDI
ACTB3: XWD D,IACS
XWD D,RACS
;GETAC SEARCHES FOR A FREE AC, EITHER I-TIME OR
; R-TIME, AS INDICATED BY THE STATE OF THE FLAG IN H.
GETAC: SKIPE H ;ARE WE EMITTING R-TIME CODE ?
GETRAC: SKIPA T3,[XWD SRACBT+A,RACS] ;YES, FIND A R-TIME AC.
GETIAC: MOVE T3,[XWD SIACBT+A,IACS] ;FIND AN I-TIME AC.
MOVE A,[XWD -NACS,NFACS] ;CONSIDER ONLY AC'S 4-14
TRNE FL,CSBRBT ; ..UNLESS WE'RE COMPILING A FUNCTION..
MOVE A,[XWD -NFACS,0] ;WE ARE. CONSIDER ONLY 0-3.
SKIPE @T3 ;INDIRECT ADDRESSING IS GOOD FOR YOU.
AOBJN A,.-1 ;NOT FREE. TRY FOR NEXT ONE.
JUMPLE A,GETAC3 ;DID WE FIND ONE ?
PUSHJ P,GETAC2 ;NO. STORE ONE.
GETAC3: HRLI A,SRACBT ;YES. PUT IN APPROPRIATE FLAG BITS.
TLNN T3,SRACBT ;OOPS, IT'S AN I-TIME AC.
HRLI A, SIACBT
POPJ P,
GETAC2: SUBI A,1 ;STORE HIGHEST AC.
GSVAC: MOVE T,@T3 ;FIND OUT WHO'S IN HIM.
MOVE B,VLOC ;GET LOC. TO STORE HIM IN.
MOVEM B,(T) ;FIX UP HIS STACK ENTRY.
SETZM @T3 ;MARK HIM EMPTY.
MOVSI C,(<MOVEM>) ;EMIT THE STORE INST.
PUSHJ P,EMINST
JRST EMDV ;LEAVE A PLACE IN VARIABLES AREA.
;MRKAC PUTS THE AC SYMBOL IN A BACK ON THE STACK AND MARKS
; THE CORRESPONDING AC AS FULL.
MRKAC0: IOR A,MRKTAB(H) ;MARK IAC 1 OR RAC 1 FULL.
MRKAC: PUSH OSP,A ;PUT IT ON STACK.
TLNN A,SRACBT ;AN R-TIME AC?
HRRZM OSP,IACS(A) ;NO, MARK CORRESPONDING I-TIME AC FULL.
TLNE A,SRACBT
HRRZM OSP, RACS(A)
CPOPJ: POPJ P,
MRKTAB: XWD SIACBT,0 ;DESCRIPTOR FOR I-TIME AC NO. 1
XWD SRACBT,0 ;R-TIME AC 1.
;; MORE GENERATORS.
GAPAR: ;; HANDLE A PARAMETER WHICH IS AN ARRAY NAME.
TLNE A,SWVBT ;IS IT AN ARRAY IDENTIFIER OR
HRR A,(A)
TLNE A,FPARBT+SWVBT ; A FORMAL PARAMETER ?
JRST GAPR1 ;YES.
TLNE A,FOOBIT ;BETTER BE A FOO-SYMBOL, THEN....
TRZN A,400000 ;FURTHERMORE, IT MUST BE A P-SYM.
ERROR(IMPROPER ARRAY PARAMETER)
PUSH P,A ;SAVE P NO.
PUSHJ P,GETIAC ;FIND FREE I-TIME AC.
POP P,B
ADDI B,PBASE ;CALC. ADDR. OF P-SYMBOL.
MOVE C,[MOVE EMICDI] ;EMIT MOVE AC,P-SYMBOL TO THE
PUSHJ P,EMINST ;I-TIME CODE STREAM.
HRLI A,(<MOVEM>) ;NOW A MOVEM AC, INTO THE PARAMETER
DPB A,[POINT 4,A,12] ;LOCATION.
TRZA A,-1 ;CLEAR ADDRESS FIELD.
GDPAR: MOVSI A,(<SETZM>) ;PARAM. LIST AT I-TIME.
PUSH OSP,ILOC ;PUT ARRAY MARKER IN OPERAND
MOVSI T,SWVBT+FPARBT ;STACK SO A FIXUP CAN BE EMITTED TO
IORM T,(OSP) ;THE UPCOMMING HRRM WHEN THE PARAMETERS
MOVEI B,0 ;NO RELOCATION, PLEASE.
JRST EMICDI ;EMIT HRRM TO STORE ARRAY LOC. INTO
;PARAMETER CELL, AND RETURN.
GAPR1: PUSH OSP,A ;PLACE IN OPERAND STACK.
POPJ P,
GFUNC: ;; GENERATE A FUNCTION CALL.
MOVE A,@-3(P) ;PICK UP THE CALLING INSTR. FOR THE FUNCTION.
MOVE D,RLOC ;DECIDE WHETHER CALL IS TO BE IN
MOVEI H,0 ;R-TIME OR I-TIME CODE.
TLZN A,20 ;IND. BIT IN INSTR. SAYS R-TIME ALWAYS.
CAME D,-4(P) ;ALSO R-TIME IF ANY R-TIME PARAMETERS
MOVEI H,1 ;HAVE BEEN COMPILED.
GFUNC8: MOVE T3,ACTB1(H)
MOVSI A,-NFACS ;PREPARE TO SEARCH AC'S 0-4.
SKIPN T,@T3 ;IS THIS ONE IN USE ?
AOBJN A,.-1 ;NO.
JUMPG A,GFUNC6 ;DID WE FIND A BUSY ONE ?
PUSHJ P,GSVAC ;YES. SAVE IT.
JRST GFUNC8
GFUNC6: PUSH P,-1(P) ;PUT PAR. COUNT ON STACK.
HRRZM P,TEMP1# ;SAVE LOC. OF COUNT.
GFUNC5: SOSGE @TEMP1 ;MORE PARAMS ?
JRST GFUNC4 ;NO.
PUSHJ P,GMURK1 ;GET A PARAM.
TLNN E,SWVBT
TLNN E,FPARBT ;IS IT A FORMAL PARAMETER ?
JRST GFUNC7 ;NO, THANK GOD.
MOVE A,E ;SIGH. THE PRICE OF HONESTY ...
HRLI A,(<MOVE (RA)>) ;EMIT CODE TO PICK UP THE
MOVEI B,0 ;PARAM. PTR. AND PUT IT IN THE
PUSHJ P,@EMITB(H) ;CURRENT CALLING SEQUENCE.
MOVE E,ILOC(H) ;SAVE ILOC OR RLOC FOR LATER FIXUP.
TLO E,FPARBT ;MIGHT AS WELL USE THIS BIT...
MOVSI A,(<MOVEM>) ;NOW THE SECOND INSTR....
PUSHJ P,@EMITB(H)
GFUNC7: PUSH P,E ;SAVE IT.
JRST GFUNC5 ;GET ANOTHER.
GFUNC4: POP OSP,A ;NOW EMIT THE CALLING INSTR.
GFUNC2: LDB B,[POINT 4,A,17] ;RELOC. BITS.
TLZ A,37
TLZE A,SWVBT ;IS IT AN ARRAY NAME ?
TLO A,INSXR ;YES. ADD INDEX FIELD.
GFUNC3: PUSHJ P,@EMITB(H) ;
POP P,A ;GET PARAM. FROM STACK.
JUMPL A,CPOPJ ;IF IT'S THE MARK, RETURN.
TLZN A,FPARBT ;IS IT A FORMAL PARAMETER ?
JRST GFUNC2 ;NO. EMIT IT.
MOVEI B,.FXBTS ;YES. EMIT A FIXUP TO THE RIGHT INSTRUCTION.
TLZ A,400000+LRFXBT+SWAPBT ;A REPLACEMENT FIXUP TO RT. HALF.
TLO A,RRFXBT
PUSHJ P,@EMITB2(H) ;EMIT IT TO I-TIME OR R-TIME BUFER.
MOVEI B,0 ;NOW RESERVE SPACE FOR THE PARAM.
JRST GFUNC3
EMITB2: EMICD
EMCD
ACTB1: XWD SIACBT+A,IACS ;PTR. TO IACS,INDEXED BY B.
XWD SRACBT+A,RACS
;; UTILITY RUOTINE TO ENTER AN ITEM IN THE MAIN SYMBOL TAB.
GETNAM: PUSHJ P,SCANV ;SCAN AN IDENTIFIER.
GETNM1: AOS T,(P) ;TO SKIP PARAM ON RETURN.
JUMPE A,GNM2 ;SHOULD BE UNDEFINED...
TLOE A,DF ;IT'S NOT. MAYBE IT'S A DELIMITER ?
ERROR (MISSING IDENTIFIER)
TLNN A,@-1(T) ;NO. MAYBE ALREADY RIGHT TYPE ?
ERROR (MULTIPLY DEFINED SYMBOL)
SKIPGE -1(T) ;AH, IT IS. SHOULD WE REENTER IT ?
POPJ P, ;NO. ITS OLD ENTRY WILL DO.
GNM2: HRLZ A,-1(T) ;YES. GET TYPE BITS.
AENTER: HRRZ JOBFF ;GET NEXT FREE LOCATION.
HRRZ B,CBNO ;GET BUCKET NO. OF THING JUST SCANNED.
EXCH BUCTBL(B) ;UPDATE BUCKET HEAD.
AOS B,JOBFF
MOVEM -1(B) ;PUT THE LINK IN THE NEW ENTRY.
MOVEM A,1(B) ;PUT THE RANDOM GOOD BITS IN.
MOVE ACCUM ;GET FIRST WORD OF NAME.
MOVEM (B) ;PUT IN TABLE.
AOS B,JOBFF
MOVEI T,ACCUM+1 ;PREPARE TO MOVE REST OF NAME.
AEL1: AOS JOBFF
SKIPN T1,(T) ;ANY MORE OF THE NAME ?
JRST AEL2 ;NO.
MOVEM T1,@JOBFF ;YES. PUT IN TABLE.
CAIL T,ACCUM+2 ;UNLESS FIRST OR SECOND WORD,
SETZM (T) ;ZERO WORD IN ACCUM.
AOJA T,AEL1
AEL2: HRRZ JOBSYM ;GET BOTTOM OF BUFFER AREA.
CAMG JOBFF ;HAVE WE OVERRUN IT ?
ERROR(CORE IS FULL)
HRR A,B
HRRZ JOBFF
HRLM JOBSA
POPJ P,
;; INITIALIZATION OF THE COMPILER.
EXTERNAL JOBFF,JOBSA
JOBSYM: 0
SCOMPA: MOVE OSP,[XWD -LOSTK,OSTK-1] ;INIT. OPERAND STACK.
PUSH OSP,JOBSYM ;...SO WE CAN RESTORE IT LATER.
MOVSI IRELBT ;INIT THE THREE LOCATION
MOVEM ILOC ;COUNTERS (APPROPRIATE RELOCATION
MOVSI RRELBT ;BITS LIVE IN LEFT HALF OF EACH).
MOVEM RLOC
MOVSI VRELBT
MOVEM VLOC
MOVEI T1,2 ;SET UP THE THREE CHAINS OF OUTPUT
SCMP1: SETZM OBPTR(T1)
PUSHJ P,GBUF ;BUFFERS.
HRRZM T,FCBUF(T1) ;PTR. TO FIRST BUFFER OF CHAIN
SOJGE T1,SCMP1 ;DO FOR ALL THREE CHAINS.
SETZM IARR1 ;ZERO SOME TABLES AND STUFF.
MOVE [XWD IARR1,IARR1+1]
BLT IARR2-1
MOVEI FL,0 ;CLEAR FLAGS.
POPJ P,
SCOMP: PUSHJ P,SCOMPA ;INIT. THE COMPILER.
MOVE [XWD IARR2-1,IARR2]
BLT IARR3-1 ;ZERO REST OF TABLES.
POPJ P,
;; SYNTAX ANALYZER.
SSTATL: PUSHJ P,SMCSCN ;SCAN NEXT NON-SEMICOLON.
STATL: CAMN A,FINV ;IS IT A FINISH ?
JRST ENDP1 ;YES.
PUSHJ P,STAT ;NO. SCAN A STATEMENT.
JRST SSTATL ;GO BACK FOR MORE.
SSTAT: PUSHJ P,SMCSCN
STAT: MOVEI H,0 ;CLEAR 'R-TIME CODE' FLAG.
JUMPGE A,STAT2 ;A DELIMITER ?
TLNE A,DECLBIT ;YES. A DECLARATION ?
JRST (A) ;YES. DISPATCH TO RIGHT ROUTINE.
STAT2: PUSHJ P,STMT1 ;IT HAS TO BE A STMT1.
STATL1: CAME A,SEMICV ;SEMICOLON AFTER EVERY STMT.,PLEASE.
ERROR (MISSING SEMICOLON) ;I HATE MYSELF FOR THIS.
TDZ FL,[XWD ERRFLG,EXTFLG] ;TURN OFF ERROR FLAG.
POPJ P, ;END OF STATEMENT.
EXTD: PUSHJ P,SCAN ;"EXTERNAL" DECLARATION.
CAME A,FUNV ;BETTER BE "FUNCTION".
ERROR (<EXTERNAL FUNCTIONS ONLY,PLEASE.>)
TRO FL,EXTFLG ;SET FLAG.
JRST DFUNC
SSTMT1: PUSHJ P,SCAN
STMT1: SKIPN A ;IS IT UNDEFINED ?
ERROR (UNDEFINED IDENTIFIER)
STMT1A: TLNE A,FUNBIT ;<STMT1>=<FUNCTION CALL> ! <ASN. STMT>
JRST SFUNC ;A FUNCTION CALL.
TLNN A,VRBLBT!FOOBIT ;BETTER BE A SIMPLE VARIABLE.
ERROR (SIMPLE VARIABLE REQUIRED HERE.)
PUSH OSP,A ;STACK IT.
PUSHJ P,SCAN ;GET LEFT ARROW.
CAME A,LARV
ERROR (ILLEGAL STATEMENT)
PUSHJ P,ASTMT1 ;IT'S AN ASSIGNMENT STMT. COMPILE IT.
JRST POPAJ ;RESTORE A(WHICH WAS SAVED BY ASTMT)
; AND RETURN.
SFUNC: PUSHJ P,FUNCAL ;COMPILE FUNCTION CALL
JRST SCAN ;RETURN.
SMSC1:
SMCSCN: PUSHJ P,SCAN ;SCAN PAST NEXT SEMICOLON.
SMCS1: CAMN A,SEMICV
JRST SMCSCN
POPJ P,
ENDSTL: RELEAS DT, ;ALL DONE. RELEAS INPUT DEVICE.
ENDP1:
MOVEI A,0
MOVEI B,.FXBTS ;PUT END MARKS IN THE BUFFERS.
PUSHJ P,EMCD
PUSHJ P,EMICD
PUSHJ P,EMVCD
POP OSP,JOBSYM ;RESTORE JOBSYM.
POPJ P,
EXTERNAL JOBDDT,JOBREL
DVRBL1: CAME A,COMMAV ;IS IT A COMMA ?
JRST STATL1 ;NO. END OF DECL.
DVRBL: PUSHJ P,SCAN ;GET NEXT ITEM.
CAMN A,CTBL+"/" ;IS IT A "/" ?
JRST DVRBL2 ;YES. DEFINE FOLLOWING VARIABLE AS R-TIME.
PUSHJ P,GETNM1 ;NO. MUST BE NAME OF VARIABLE. PUT IN SYM. TABLE.
XWD 400000,VRBLBT ;PARAM. TO GETNM1.
DVRBL4: JUMPL A,DVRBL3 ;WAS IT ALREADY DEFINED ?
AOS A,JOBFF ;NO, IT'S NEW. LEAVE WORD FOR THE VALUE.
SUBI A,1 ;GET PTR. TO THAT WORD.
HRRM A,(B) ;PUT IN GOOD BITS WORD (NO REL. BITS).
DVRBL3: PUSHJ P,SCAN ;GET COMMA OR SEMICOLON.
JRST DVRBL1 ;BACK FOR MORE.
DVRBL2: PUSHJ P,GETNAM ;SCAN AND ENTER NAME OF VARIABLE.
XWD 400000,VRBLBT!RVBT ;INCLUDE 'R-TIME' BIT.
JRST DVRBL4
DF5: CAME A,COMMAV ;ARE THERE MORE DEFINITIONS ?
JRST STATL1 ;NO.
DFUNC: TRO FL,CSBRBT+SFOOBT ;ENTER FUNCTION DEFINING MODE.
PUSHJ P,GETNAM ;GET FUNCTION NAME.
EXP FUNBIT ;PARAMETER TO GETNAM.
PUSH P,BUCTBL ;####$$%%$ A TEMPORARY KLUGE !!
MOVE A,JOBFF ;GET FIRST FREE STORAGE LOC.
HRRM A,(B) ;MAKE GOOD BITS WORD POINT THERE.
HRLI A,600 ;MAKE A INTO A BYTE POINTER.
PUSH P,A
PUSH P,A
IBP (P) ;THIS POINTER IS FOR PARAMETER DESCRIPTORS.
HRLI A,400000+LRFXBT+RRFXBT ;NOW EMIT FIXUP TO THE LOCATION IN THE SYM. TABLE WHICH WILL
MOVEI B,.FXBTS ;CONTAIN THE CALLING INSTR. FOR THE FUNCTION, SO IT CAN BE UPDATED AT
PUSHJ P,EMICD ;LOAD TIME WITH THE RELOCATED ADDRESS OF THE FUNCTION.
ADDI A,5 ;LEAVE ENOUGH ROOM FOR 22 PARAMETER
HRRZM A,JOBFF ;DESCRIPTORS.
TRNN FL,EXTFLG ;IS IT AN EXTERNAL FUNCTION ?
SKIPA A,ILOC ;NO. ADDRESS IS IN ILOC.
PUSHJ P,SYMSCH ;YES. FIND STARTING ADDRESS.
TLO A,(<JSA RA,>) ;MAKE INTO A CALLING INSTR.
MOVEM A,@-1(P) ;PLACE IN SYM. TABLE.
LDB B,[POINT 4,A,17] ;GET THE RELOCATION BITS.
TLZ A,17 ;TURN THEM OFF IN THE INSTRUCTION WORD.
PUSHJ P,EMICD ;EMIT AS VALUE OF ABOVE FIXUP.
PUSH P,[-1] ;INIT. THE PARAMETER COUNT.
PUSHJ P,SCAN ;LOOK AT NEXT THING.
CAME A,LPARV ;A ( ?
JRST DFNOPR ;NO. THERE ARE NO PARAMETERS.
DF2: PUSHJ P,SCAN ;SCAN A PARAMETER.
CAME A,ARRV ;IS IT AN ARRAY NAME ?
JRST DF2A ;NO.
TRO FL,ARRFLG ;YUP. SET FLAG AND GET NAME OF
JRST DF2 ;PARAM.
DF2A: TLNE A,DF+NUMFLG
ERROR (ILLEGAL FORMAL PARAMETER)
AOS A,(P) ;INCREMENT PARAMETER COUNT.
HRLI A,FPARBT!VRBLBT ;MAKE A INTO FORMAL PARAM. INDICATOR
PUSHJ P,AENTER ; AND ENTER THE SYMBOL.
MOVEI 2 ;PUT 'ORDINARY' FLAG IN THE PARAMETER
TRZE FL,ARRFLG ;AN ARRAY NAME PARAM. ?
MOVEI 1 ;YES. USE RIGHT DESCRIPTOR BIT.
IDPB -1(P) ;DESCRIPTOR FOR THIS PARAM.
PUSHJ P,SCAN
CAMN A,COMMAV ;A COMMA ?
JRST DF2 ;YES LOOK FOR MORE PARAMETERS.
CAME A,RPARV ;IT BETTER BE A ).
ERROR (MISSING RIGHT PAREN.)
PUSHJ P,SCAN ;GET THE =.
MOVEI B,0 ;FLAG END OF PARAMETER DESCRIPTORS.
IDPB B,-1(P)
DFNOPR: TRNE FL,EXTFLG ;IS THIS AN EXTERNAL FUNCTION ?
JRST DF4 ;YES. LOOK FOR NO DEFINITION.
CAME A,CTBL+"="
ERROR (MISSING = IN FUNCTION DEFINITION)
PUSHJ P,EMICDI ;LEAVE ROOM FOR THE JSA WORD.
TRZ FL,SFOOBT ;LET SCANNER SEE FOO-SYMBOLS AGAIN.
PUSHJ P,SEXPR ;SCAN AN EXPRESSION.
DF4: PUSH P,A
TRNE FL,EXTFLG ;AN EXTERNAL ?
SKIPA E,[XWD SIACBT,0] ;YES. RESULT ALWAYS IN 0.
PUSHJ P,GMURK1 ;GET IT OFF STACK.
PUSHJ P,GG2 ;MAKE SURE ITS IN AN AC.
IDPB A,-2(P) ;TELL UNIVERSE WHICH AC .
AOS B,-1(P) ;ADJUST PARAMETER COUNT.
IDPB B,-3(P) ;PUT IN SYM. TABLE.
MOVEI A,RA ;EMIT RETURN INSTR.
MOVSI C,(<JRA RA,(RA)>)
TRNN FL,EXTFLG ;...UNLESS THIS IS AN EXTERNAL.
PUSHJ P,EMINST
AOS A,-2(P) ;FIND TOP OF PARAM. DESC. STRING.
HRRZM A,JOBFF ;RESET FREE STORAGE.
HRLM A,JOBSA
POP P,A
SUB P,[XWD 3,3] ;FORGET JUNK IN STACK.
POP P,BUCTBL ;##$$%$# MORE OF THAT KLUGE !!!
TRZ FL,CSBRBT+SFOOBT ;LEAVE FUNCTION DEFINING MODE.
JRST DF5 ;ALL DONE.
;; MORE SYNTAX ANALYZER. COMPILE AN INSTRUMENT DEFINITION.
CINS: PUSHJ P,GETNAM ;GET NAME OF INSTRUMENT.
EXP INSBIT ;PARAMETER TO GETNAM.
AOS A,JOBFF ;GET PLACE FOR MORE GOOD BITS..
SUBI A,1
HRRM A,(B) ;MAKE RANDOM BITS WORD POINT THERE.
HRLI A,RRFXBT ;RIGHT HALF REPLACEMENT TYPE FIXUP.
MOVEI B,.FXBTS ;EMIT FIXUP TO RIGHT HALF FROM
PUSHJ P,EMICD ;FIRST LOC. OF I-TIME CODE.
HRLI A,LRFXBT+SWAPBT ;FIXUP TO LEFT HALF FROM FIRST LOC.
PUSHJ P,EMCD ;OF R-TIME CODE.
CINS5: PUSHJ P,SCAN
CINS3: PUSHJ P,SMCS1 ;IGNORE SEMICOLON, IF ANY.
CAMN A,ENDV ;IS IT AN END ?
JRST CINSE ;YES.
TLNN A,UGBIT ;IS IT A UNIT GENERATOR CALL ?
JRST CINS4 ;NOT A UNIT GENERATOR.
HRRZM A,CINST1# ;SAVE IT.
PUSHJ P,SCAN ;PEEK AT NEXT THING.
CAMN A,CTBL+"[" ;IS IT A [ ?
JRST CUG1 ;YES. UNIT GEN. HAS CONTROLLED CALLING RATE.
MOVEM A,SNCHR ;NO, IT'S PROBABLY THE (. PUT IT BACK WHERE SCAN WILL SEE IT AGAIN.
PUSHJ P,CINS6 ;NOW COMPILE THE CALL ON THE UNIT GEN.
JRST CINS5 ;BACK FOR MORE.
CINS6: MOVE A,CINST1 ;RECOVER POINTER FOR USE OF FUNCAL.
PUSHJ P,FUNCAL ;COMPILE CALL ON THE UNIT GEN.
MOVE B,VLOC ;GET LOC. FOR OUTPUT OF UNIT GEN.
AOS C,UOPTR ;INCREMENT COUNT OF UNIT GENS.
MOVEM B,UOTBL(C) ;ENTER OUTPUT LOC. IN TABLE.
MOVE C,[MOVEM EMCDI] ;EMIT STORE INSTRUCTION TO
PUSHJ P,EMINST ;PUT OUTPUT OF UNIT GEN. AWAY.
PUSHJ P,EMDV ;MAKE ROOM IN VARIABLES AREA FOR IT.
MOVE T,@CINST1 ;RETRIEVE PTR. TO RANDOM GOOD BITS.
SKIPN A,-1(T) ;DOES UNIT GEN. HAVE I-TIME CODE?
POPJ P, ;NO.
PUSHJ P,EMIABS ;YUP. EMIT THE CALLING INSTR.
HRRZ A,RLOC ;AS PARAMETER, GIVE IT A PTR. TO
MOVEI B,RRELBT ;JUST AFTER THE MOVEM EMITTED
PUSHJ P,EMICDI ;ABOVE.
POPJ P,
CINS4: PUSHJ P,STMT1 ;ITS NOT A UNIT GEN. CALL.
JRST CINS3 ;NO
CINSE: SETZM IARR1 ;YES. ZERO THINGS.
MOVE [XWD IARR1,IARR1+1]
BLT IARR3-1
MOVE A,[POPJ P,] ;PUT RETURN INSTR. AT END OF
MOVEI B,0 ;THE I-TIME CODE.
PUSHJ P,EMICDI
PUSHJ P,EMCDI ;ALSO THE R-TIME CODE.
CINSR1: PUSHJ P,SCAN
JRST STATL1
;; IF THE NAME OF A UNIT GENERATOR IS FOLLOWED BY AN
;; EXPRESSION IN SQUARE BRACKETS, THE U.G. GETS CALLED ONLY
;; EVERY N TIME STEPS, WHERE N IS THE VALUE OF THE EXPRESSION.
;; N IS RECALCULATED EVERY TIME THE U.G. IS CALLED.
CUG1: MOVE C,[AOSGE EMCDI] ;INSTR. TO COUNT NO. OF TIME STEPS TO SKIP THIS UG.
MOVE B,VLOC ;GRAB LOCATION IN VARIABLE AREA TO HOLD COUNT OF TIME STEPS TO SKIP.
MOVEI A,0 ;NO AC FIELD, PLEASE.
PUSHJ P,EMINST ;EMIT THE AOSGE JUST AHEAD OF THE CODE TO CALL THE U.G.
MOVE C,[SETZM EMICDI] ;ALSO EMIT AN INSTR. TO THE I-TIME
MOVE B,VLOC ;CODE TO INIT. THE COUNTER LOCATION TO 0 (SO U.G. GETS CALLED FIRST TIME).
PUSHJ P,EMINST
PUSH P,RLOC ;SAVE R-TIME LOC. COUNTER (FOR LATER FIXUP TO JRST WE ARE ABOUT TO EMIT).
PUSH P,VLOC ;ALSO VARIABLE LOC., FOR LATER LOADING OF THE STEPS-TO-SKIP COUNTER.
PUSHJ P,EMDV ;MAKE A WORD FOR IT.
MOVSI A,(<JRST>) ;NOW EMIT THE JUMP AROUND THE CALL OFλ
IPUSHJ P,EMCDI ;THE U.G. !!"" N.B.: B IS 0 HERE FROM CALL ON EMDV !!
PUSHJ P,SEXPR ;NOW COMPILE THE EXPRESSION IN THE BRACKETS.
CAME A,CTBL+"]" ;SHOULD BE FOLLOWED BY ONE...
ERROR (MISSING ])
MOVEI H,1 ;INDICATE THAT WE ARE WORKING WITH R-TIME CODE...
PUSHJ P,GMURK1 ;..AND GET EXPR OFF OPERAND STACK.
PUSHJ P,GG2 ;NOW GET IT INTO AN AC.
MOVSI C,(<FIX>) ;EMIT INSTR. TO FIX VALUE OF EXPRESSION.
MOVEI B,233000 ;MAGIC NO. FOR ADDRESS OF FIX, HO HO.
PUSHJ P,EMINST
POP P,B ;GET LOCATION IN VARIABLE AREA OF THE STEPS-TO-SKIP COUNTER.
MOVSI C,(<MOVNM>) ;AND EMIT INSTR. TO STORE NEGATIVE OF COUNT THERE.
PUSHJ P,EMINST
PUSHJ P,CINS6 ;NOW COMPILE CALL ON UNIT GENERATOR.
POP P,A ;RECOVER LOC. OF THE JRST UNDER THE AOSGE.
MOVEI B,.FXBTS ;EMIT FIXUP TO MAKE IT POINT HERE (I.E., AFTER
PUSHJ P,EMCD ; END OF U.G. CALL).
JRST CINS5 ;ALL DONE.
;; THE WONDERFUL, WINNING LOADER.
R←←1
I←←2
V←←3
LOADER: MOVE R,JOBFF ;R-TIME CODE RELOCATION CONST.
HRRZ I,RLOC ;
ADD I,R ;I-TIME CONST.
HRRZ V,ILOC
ADD V,I ;VARIABLE RELOC. CONST.
MOVE T3,V
ADD T3,VLOC ;PROGRAM BREAK.
HRRZM T3,JOBFF
HRLM T3,JOBSA ;MAKE SURE IT TAKES.
HRL A,R ;ZERO THE PROGRAM AREA.
HRRI A,1(R)
SETZM (R)
BLT A,-1(T3)
MOVEI H,0 ;START WITH R-TIME CODE.
LD1: ADDI H,1 ;GO TO NEXT CHAIN OF BUFFERS.
CAILE H,3 ;ALL DONE ?
POPJ P, ;YES.
PUSH P,[LDL1] ;FAKE UP A RETURN TO LDL1.
MOVE C,(H) ;INIT. THE CURRENT LOC. COUNTER.
SKIPA F,FCBUF-1(H) ;PTR. TO FIRST BUF. OF CHAIN.
LD2: HRRZ F,(F) ;PTR. TO NEXT BUF. OF CHAIN.
HRRZ E,F ;SET UP BYTE PTR. TO RELOC. BITS.
HRLI E,200
HRRZI D,LOBUFS/12+2(F) ;PTR. TO DATA IN BUF.
HRLI D,-<LOBUFS-LOBUFS/12-2> ;WORD COUNT.
LDGW: AOBJP D,LD2 ;WORD COUNT EXHAUSTED ?
MOVE (D) ;NO. PICK UP NEXT DATA WORD.
ILDB A,E ;FIRST 2 REL. BITS.
ILDB B,E ;LAST 2.
POPJ P,
LDL: PUSHJ P,LDGW ;GET NEXT WORD FROM BUFFER.
LDL1: JUMPE A,LDF1 ;NO REL. GIVEN; MAY BE A FIXUP.
JUMPE B,LDRST ;IF NEITHER HALF, THEN IT'S A RESET.
PUSH P,CLD3 ;ANOTHER FAKE RETURN ADDRESS.
LDRL1: TRNE B,1 ;RELOCATE RIGHT HALF ?
ADD (A) ;YES.
TRNN B,2 ;LEFT HALF ?
POPJ P, ;NO.
MOVSS (A)
ADD (A)
MOVSS (A)
POPJ P,
LD3: ADDM (C) ;PUT IN CORE.
CLDL: AOJA C,LDL ;GET ANOTHER.
;; MORE LOADER (BUT NOT MUCH MORE, YOU WILL NOTICE !).
LDF1:
CLD3: JUMPE B,LD3 ;PERHAPS NOT A FIXUP.
JUMPE LD1 ;IT MIGHT EVEN BE AN END MARK.
LDB T3,[POINT 2,0,15] ;A FIXUP. GET REL. BITS FOR PTR.
DPB T3,[POINT 5,0,17]
PUSH P,0
JUMPG LDF2 ;IS VALUE OF FIXUP TO BE FOUND IN BUFFER ?
PUSHJ P,LDGW ;YES. GET IT.
PUSHJ P,LDRL1 ;PERFORM ANY INDICATED RELOCATION ON IT.
SKIPA T3,0 ;MOVE RELOCATED VALUE INTO T3.
LDF2: MOVE T3,C ;VALUE IS CURRENT LOCATION.
POP P,0 ;BRING BACK THE POINTER WORD.
TLNE SWAPBT ;SHOULD WE EXCHANGE HALVES OF THE VALUE ?
MOVSS T3 ;YES.
TLNE RRFXBT ;SHOULD WE REPLACE THE RIGHT HALF OF THE LOCATION?
HRRM T3,@0 ;YES. SEE THE POINTER RELOCATION HAPPEN AUTOMATICALLY!!
TLNE LRFXBT ;REPLACE THE LEFT HALF ?
HLLM T3,@0 ;YES.
TLNN LRFXBT+RRFXBT ;IF NEITHER HALF REPLACED, THEN
ADDM T3,@0 ;IT'S AN ADDITIVE FIXUP.
JRST LDL ;BACK TO MAIN LOOP.
LDRST: HALT ;THE FEATURE YOU HAVE REQUESTED ...
DARR: PUSH P,[0] ;DEFINE SOME ARRAYS.
DARR1: PUSHJ P,GETNAM ;SCAN NAME.
XWD DF,SWVBT ;TYPE PARAMETER TO GETNAM.
PUSH P,A ;STACK PTR. TO ENTRY.
PUSHJ P,SCAN ;LOOK FOR COMMA.
CAMN A,COMMAV ;IS IT ONE ?
JRST DARR1 ;YES. GET MORE NAMES.
CAME A,LPARV ;NO. SHOULD BE A (.
ERROR(MISSING LEFT PAREN.)
PUSHJ P,SCAN ;GET THE DIMENSION.
TLNN A,NUMFLG ;MAKE SURE IT'S A NUMBER.
ERROR(IMPROPER DIMENSION)
MOVE B,(A) ;GET VALUE.
TLNN A,FIXFLG ;IS IT FLOATING ?
FIX B,233000
DARR3: AOS JOBFF ;GET FREE STORAGE PTR.
POP P,T ;PTR. TO NAME IN TABLE...
JUMPE T,DARR2 ;UNLESS ITS THE MARK.
JUMPG T,DARR4 ;WAS IT PREVIOUSLY DEFINED ?
HRRZ T1,(T) ;YES. GET ITS BASE ADDRESS.
CAMG B,-1(T1) ;IS NEW DIMENSION > OLD ?
JRST DARR3 ;NO. LEAVE OLD DEFINITION ALONE.
DARR4: AOS A,JOBFF ;INCREMENT FREE STG. PTR. AGAIN.
HRRM A,(T) ;PUT IN SYM. TABLE.
MOVEM B,-1(A) ;PUT DIMENSION IN -1TH ELEMENT.
HRLI A,INSXR ;PUT GOOD INDEX FIELD IN A...
MOVEM A,-2(A) ;PUT PTR. TO ARRAY WITH INDEX IN AR[-2]
ADDM B,JOBFF ;INCREMENT IT.
JRST DARR3 ;TRY FOR ANOTHER.
DARR2: PUSHJ P,SCAN ;GET THE ).
CAME A,RPARV
ERROR(MISSING RIGHT PAREN.)
PUSHJ P,SCAN
CAMN A,COMMAV ;A COMMA ?
JRST DARR ;YES. START OVER AGAIN.
HRRZ JOBSYM ;LET'S FIND OUT IF WE'VE LOST...
CAMG JOBFF ;IS TOP STILL ABOVE BOTTOM ?
ERROR(STORAGE IS FULL)
HRRZ JOBFF
HRLM JOBSA
JRST STATL1
; HERE IS THE OUTER LOOP OF THE WHOLE SYSTEM.
CHOWN1: PUSHJ P,INTER1 ;INTERPRET STATEMENT.
SCHOWN: PUSHJ P,SMSC1 ;GET FIRST NON-SEMICOLON.
CHOWN: CAMN A,PLAYV ;IS IT A 'PLAY' SECTION ?
JRST PLAY1 ;YES.
CAMN A,ALTV ;IS IT AN ALT MODE ?
JRST COMMND ;YES. A COMMAND FOLLOWS.
CAME A, COMPV ;A 'COMPILE' SECTION ?
JRST CHOWN1 ;NO. JUST A STATEMENT.
PUSHJ P,SCOMP ;INIT. THE COMPILER.
PUSHJ P,SSTATL ;COMPILE A STATEMENT LIST.
PUSHJ P,LOADER ;LOAD THE CODE.
JRST SCHOWN ;DONE WITH THAT SECTION.
PLAY1: PUSHJ P,GSBUF ;WE'RE GOING TO PLAY; GET SAMPLE BUFFER.
AOS SBCNT
PLAY1A: SETZM TIME# ;T←0.
SETZM RQPTR# ;RUN QUEUE IS EMPTY.
SETZM MAXSMP# ;INIT. THE MAXIMUM SAMPLE REMEMBERER.
PLAY2: PUSHJ P,SMSC1 ;SCAN A NON-SEMICOLON.
CAME A,FINV ;A 'FINISH ' ?
CAMN A,PLAYV ;... OR A 'PLAY' ?
JRST PTERM ;YES. END OF SECTION.
TLNE A,INSBIT ;AN INSTRUMENT NAME ?
JRST PINS ;YES. A NOTE STATEMENT.
PUSH P,[EXP PLAY2] ;NO. INTERPRET THE STATEMENT.
INTER1: CAME A,INSV
CAMN A,FUNV
ERROR (ILLEGAL 'PLAY' STATEMENT)
PUSHJ P,SCOMPA ;IT MUST BE A RANDOM STATEMENT.
;PREPARE TO INTERPRET IT BY INITIALIZING
;THE COMPILER.
PUSHJ P,STAT ;COMPILE THE STATEMENT.
INTERP: MOVE A,[JRST INTER2] ;PREPARE TO EXECUTE TEMPORARY
MOVEI B,0 ;CODE (I.E,RUN IN INTERPRET MODE).
PUSHJ P,EMICDI ;EMIT RETURN INSTR. AT END OF CODE.
PUSHJ P,ENDP1 ;CLEAN UP COMPILER.
PUSH P,JOBFF ;SAVE FREE STG. PTR.
PUSHJ P,LOADER ;LOAD THE TEMPORARY CODE.
MOVEM P,PSV1# ;SAVE IT.
MOVEM FL,FLSV1#
MOVE 17,P ;PTR. FOR (UGH! BLETCH!) FOOTRAN PGMS.
JRST @(P) ;EXECUTE IT.
INTER2: MOVE P,PSV1 ;RESTORE PUSHDOWN POINTER.
MOVE FL,FLSV1
POP P,0 ;RETRIEVE OLD STG. PTR.
HRRZM JOBFF ;FLUSH THE TEMP. CODE.
HRLM JOBSA ;(IT HAS TO GO HERE TOO.)
POPJ P, ;LOOK, MA, I'M AN INTERPRETER !!
;THIS CODE READS A NOTE STATEMENT, INITIALIZES THE
; INSTRUMENT, AND GETS IT TURNED ON AT THE RIGHT TIME.
PINS: MOVE A,(A) ;GET STARTING ADDRESSES FOR INSTRUMENT.
PUSH P,(A) ;SAVE THEM.
MOVEI PBASE ;PREPARE TO FILL THE P ARRAY WITH
MOVEM PPTR1# ;THE PARAMETERS TO THE INSTR.
PUSHJ P,SCOMPA ;INIT. COMPLR. FOR POSSIBLE EXPRESSIONS.
MOVE NCHNS ;GET NO. OF OUTPUT CHANNELS.
TLNE -1 ;IS IT FLOATING ?
FIX 233000
PINS2: MOVEM NCHNS
PUSH P,NUMBUC ;SAVE CURRENT STATE OF NUMBER
PUSH P,JOBFF ;BUCKET AND CORE TOP.
JRST PINSL ;INIT. THE COMPILER.
PINSL1: CAMN A,COMMAV ;OPTIONAL COMMA BETWEEN PARAMS...
PINSL: PUSHJ P,SCAN
AOS PPTR1 ;INCREMENT P-ARRAY POINTER.
CAMN A,COMMAV ;A COMMA HERE MEANS MISSING
JRST PINSL ;PARAM., SO DON'T CHANGE.
CAMN A,SEMICV ;SEMICOLON ?
JRST PINSB ;YES, END OF PARAMETERS.
PUSHJ P,EXPR ;PARAMETER MAY BE EXPRESSION.
PUSHJ P,GPONDER ;GET OPERAND POINTER FOR THE EXPR...
TLNE T,SIACBT ;IS VALUE OF EXPR AN AC SYMBOL ?
JRST PINS1 ;YES. IT HAS TO BE CALCULATED.
MOVE C,(T) ;PICK UP ITS VALUE.
MOVEM C,@PPTR1 ; SO PUT ITS VALUE IN P-ARRAY NOW.
JRST PINSL1
PINS1: PUSH P,A ;EXPR. GENERATED SOME CODE, EVIDENTLY.
MOVE A,T ;EMIT AN INSTRUCTION TO STORE THE
MOVE B,PPTR1 ;RESULTANT VALUE IN THE P-ARRAY.
MOVE C,[MOVEM EMICDI]
PUSHJ P,EMINST ;THE CODE WILL GET EXECUTED
PUSHJ P,INTERP ; RIGHT NOW.
PUSHJ P,SCOMPA
POP P,A
JRST PINSL1 ;BACK FOR MORE PARAMS.
;; MORE OF PINS.
PINSB: POP OSP,JOBSYM ;FLUSH COMPLR. OUTPUT BUFFERS.
POP P,0 ;RECOVER OLD CORE TOP.
MOVEM JOBFF ;RESET THINGS TO FORGET
HRLM JOBSA ;ABOUT THE NUMBERS WE DEFINED WHILE
POP P,NUMBUC ;SCANNING NOTE PARAMETERS.
MOVE A,SRATE ;GET NO. OF SAMPLES/SEC.
FDVR A,TIMESC ;DIVIDE BY BEATS/SEC.
MOVE B,PBASE+1 ;GET STARTING TIME FOR NOTE.
FMPR B,A ;CONVERT TO SAMPLES.
FADR B,[0.5]
FIX B,233000
MOVEM B,RQ1 ;PLACE AT BOTTOM OF RUN QUEUE.
FMPR A,PBASE+2 ;GET DURATION OF NOTE IN SAMPLES.
FADR A,[0.5]
FIX A,233000
ADD A,B ;CALC. ENDING TIME OF NOTE.
PUSH P,A ;SAVE SAME.
PUSHJ P,PLAYIT ;PLAY UP TO STARTING TIME OF NOTE.
PLYON: AOS A,RQPTR ;NOW TURN INSTRUMENT ON.
POP P,RQ1(A) ;PUT ENDING TIME IN RUNQUEUE, COL. ONE.
POP P,T ;GET STARTING ADDR. OF INSTRUMENT.
HLRZM T,RQ2(A) ;PLACE IN RUN QUEUE, COL. TWO.
PUSHJ P,(T) ;EXECUTE THE I-TIME CODE.
JRST PLAY2 ;BACK FOR MORE NOTE STATEMENTS.
PTERM: PUSH P,A ;HERE AT A 'PLAY' OR 'FINISH'.
MOVSI 200000
MOVEM RQ1 ;SET UP FAKE STARTING TIME.
PUSHJ P,PLAYIT ;FLUSH THE RUN QUEUE.
POP P,A
CAMN A,PLAYV ;WAS IT A 'PLAY' THAT WE SAW ?
JRST PLAY1A ;YES. START NEW SECTION.
PUSHJ P,OSBUF ;NO, A 'FINISH'. EMPTY THE
JRST SCHOWN ;SAMPLE BUFFER AND START OVER.
;; THIS ROUTINE GENERATES SAMPLES BY CALLING THE
;; INSTRUMENTS IN THE RUN QUEUE UNTIL IT IS TIME
;; TO TURN ON THE INSTRUMENT WHOSE STARTING TIME IS
;; IN THE ZEROTH LOCATION OF THE QUEUE, WHEN IT RETURNS.
;; INSTRUMENTS ARE TURNED OFF AS REQUIRED.
PLAYIT: MOVE A,RQPTR ;SEARCH FOR EARLIEST TIME IN QUEUE.
PLYT2: MOVEM A,PTMP# ;SAVE ITS LOCATION.
SKIPA H,RQ1(A) ;PICK IT UP.
CAMG H,RQ1(A) ;A NEW MINIMUM ?
SOJGE A,.-1 ;NO.
JUMPGE A,PLYT2 ;YES.
PLYT1: CAMN H,[XWD 200000,0] ;MIN. FOUND. IS IT THE TERMINATION
POPJ P, ; MARK ? IF YES, THEN RETURN.
SUB H,TIME ;IT'S NOT . CALC. DISTANCE IN FUTURE.
JUMPLE H,PLYT3 ;IF NOT IN FUTURE, FORGET IT.
ADDM H,TIME ;MOVE TIME TO NEW VALUE.
PLYT4: SKIPE OSP,RQPTR ;CYCLE THRU RUNNING INSTRS., IF ANY.
PUSHJ P,@RQ2(OSP) ;CALL AN INSTR.
JFCL 1,.+1 ;THIS AND NEXT FROM JC,MUS. WHY???
SOJG OSP,.-2 ;CALL THEM ALL.
;;;; SOJG OSP,.-1 ;CALL THEM ALL.
MOVEI F,1 ;START WITH CHANNEL 1.
PLYT5: SOSG SBCNT ;COUNT SAMPLE BUFFER COUNTER.
PUSHJ P,FSBUF ;FLUSH FULL BUFFER.
MOVEI B,0 ;PICK UP NEXT CHANNEL'S SAMPLE, AND
EXCH B,OUTA-1(F) ; ZERO THE LOCATION.
FAD B,[0.5] ;ROUND TO NEAREST INTEGER.
FIX B,233000 ;A. KOTOK SHOULD HAVE DONE THIS.
MOVM A,B ;GET MAGNITUDE...
CAMLE A,MAXSMP ;IS THIS SAMPLE THE BIGGEST YET ?
MOVEM A,MAXSMP ;YUP.
IDPB B,SBPTR ;PLACE IT IN SAMPLE BUFFER.
CAMGE F,NCHNS ;LAST CHANNEL ?
AOJA F,PLYT5 ;NO. GET OTHER CHANNELS.
SOJG H,PLYT4 ;GENERATE REST OF SAMPLES.
PLYT3: SKIPG A,PTMP ;GET PTR. TO NEXT INSTR. OFF OR ON.
POPJ P, ;TIME TO TURN ONE ON.
SOS B,RQPTR ;REMOVE INSTR. FROM QUEUE.
MOVE RQ1+1(B) ;MOVE TOP ENTRY DOWN INTO VACANT
MOVEM RQ1(A) ;SPOT.
MOVE RQ2+1(B)
MOVEM RQ2(A)
JRST PLAYIT ;GO PLAY TILL NEXT EVENT.
;; RANDOM ROUTINES TO HANDLE THE SAMPLE OUTPUT BUFFER.
GSBUF: HRRZ T,JOBSYM ;GET A SAMPLE BUFFER.
SUB T,JOBFF ;HOW MUCH ROOM IS LEFT ?
SUBI T,4*LOBUFS ;(ALLOWING ROOM FOR CODE BUFFERS)
SKIPN BIGBIT ;SETS LSBUF TO 1024 IF EITHER BIGBIT OR RCDFLG!
SKIPE RCDFLG
SKIPA
JRST GSBUF1 ;1023 IS FOR DEFERRED LONGPLAY
CAIGE T,=1024 ;1024 IS FOR IMMEDIATE LONGPLAY WITH 'PLAY'
ERROR (ADD 1K OF CORE!)
MOVEI T,=1023
SKIPE BIGBIT ;LOOK AT RCDFLG IF BIGBIT=0
JRST GSBUF1 ;***** 7/74 COLGATE
SKIPGE RCDFLG ;IS IT POSITIVE OR ZERO?
MOVEI T,=1024 ;NO, RCDFLG←-1; IS FOR IMMEDIATE LONGPLAY
GSBUF1: MOVEM T,LSBUF ;PUT AWAY.
MOVNS T
PUSHJ P,GFS ;GRAB ENOUGH FREE STORAGE...
HRRZM T,SBBOTT# ;SAVE PTR. TO BUFFER.
FSBUF2: HRLI T,441400 ;MAKE BYTE POINTER.
;****************************************************
SKIPE BIGBIT ;IS IT 18 BIT?
HRLI T,442200 ;YES. RESET BYTE SIZE
MOVEM T,SBPTR# ;
MOVE T,LSBUF ;GET LENGTH OF BUFFER.
ASH T,1 ;SAMPLE CT = LSBUF *2 FOR 18 BIT
SKIPN BIGBIT ;IS IT 18 BIT?
ADD T,LSBUF ;NO, MAKE * 3.
MOVEM T,SBCNT#
POPJ P,
OSBUF: HRRZ LSBUF ;THROW OUT SAMPLE BUFFER...
ADDM JOBSYM
MOVEI 0
SKIPA T,SBCNT
IDPB 0,SBPTR
SOJG T,.-1
JRST FSBUF
SMPOUT: MOVE SBBOTT
MOVEM IBOTT
; MAR 16,71 MOVE BIGBIT
; MAR 16,71 MOVEM IBIT#
JSA 16, SMPLS ;CALL WRITING ROUTINE
JUMP LSBUF
JUMP SBCNT
IBOTT: 0
JUMP MAXSMP
; MAR 16,71 JUMP IBIT
JUMP BIGBIT
JUMP RCDFLG ;RCDFLG←-1 WRITES ONE LONG .DMD FILE 6/71
SKIPN BIGBIT
SKIPE RCDFLG ;RCDFLG ON?
SKIPE DOPLAY ;PLAY ANYWAY?
JRST FSBUF1 ;GO TO PLAY
JRST FSBF2A ;DOESN'T PLAY
FSBUF: SKIPN BIGBIT
SKIPE RCDFLG# ;OUTPUT TO DISC?
JRST SMPOUT
FSBUF1: HRR SBBOTT ;CALCULATE NEGATIVE WORD COUNT.
SUB SBPTR
SUBI 1 ;PREVENT 0 WORD COUNTS.
HRRZ T,SBBOTT ;GET BOTTOM OF BUFFER....
HRLI -1(T) ; MINUS ONE.
MOVSM OUTWC ;PUT IOWD IN RIGHT PLACE.
MOVSM SOUTWC# ;SAVE FOR $P
INTERN OUTWC
EXTERN IMMPLY
INTERN NCHNS
INTERN SPEED
JSA 16,IMMPLY
FSBF2A: MOVE T,SBBOTT ;NOW SET UP POINTERS AGAIN.
JRST FSBUF2
OUTWC: 0
;; 3650 ;MAGIC BITS FOR 136.
0
OUTBIT: 4000 ;BITS FOR A-D.
BLOCK 2
;; ERROR HANDLING(?) ROUTINES.
ERR1: 0 ;HERE FROM UUO TRAP.
TLNE FL,ERRFLG ;IN ERROR SKIPPING MODE ?
JRST 2,@ERR1 ;YES.
MOVEM 17,ERSVAC+17 ;NO. SAVE ACS.
MOVEI 17,ERSVAC
BLT 17,ERSVAC+16
JSR ERR2 ;PRINT MESSAGE.
MOVSI 17,ERSVAC ;RESTORE AC'S.
BLT 17,17
ERRX: TLO FL,ERRFLG ;ENTER ERROR-SKIPPING MODE.
RELEAS TTY,0
RELEAS DT,0
PUSHJ P,SETUP1
JRST GOB
JRST 2,@ERR1 ;TRY TO CONTINUE (HO, HO.).
ERSVAC: BLOCK 20
ERR2: 0 ;ERROR MESSAGE PRINTER.
HRRZI [ASCIZ /
$$$ ERROR: /]
JSR TXTOUT
HRRZ 40
JSR TXTOUT
HRRZI [ASCIZ /
/]
JSR TXTOUT
MOVE A,ISCP
MOVE B,A
MOVE C,B
ERR2B: ILDB A
CAIE 15
JRST ERR2A
MOVE C,B
MOVE B,A
ERR2A: CAME A,SCP
JRST ERR2B
JRST ERR2D
ERR2C: SOSGE TOB+2
OUTPUT TTY,0
IDPB TOB+1
ERR2D: ILDB C
CAME C,SCP
JRST ERR2C
SKIPN SNCHR
IDPB TOB+1
OUTPUT TTY,0
JRST @ERR2
SYMSCH: MOVEI T,6 ;LOOK UP EXTERNAL SYMBOL.
MOVE [POINT 6,ACCUM,5] ;PREPARE TO CONVERT TO
MOVEI B,0
SYMS1: ILDB A,0 ;RADIX 50.
JUMPE A,SYMS4
CAIN A,16
MOVEI A,73
CAIG A,5
ADDI A,70
CAIGE A,32
ADDI A,7
IMULI B,50
ADDI B,-26(A)
SOJG T,SYMS1
SYMS4: TLO B,40000
MOVE A,116
SYMS3: AOBJP A,SYMS2
CAME B,-1(A)
AOBJN A,SYMS3
SYMS2: SKIPL A
SKIPA A,[EXP NX]
HRRZ A,(A)
POPJ P,
NX: 0
ERROR (MISSING EXTERNAL FUNCTION)
JRST INTER2
INTERNAL RDNUM,MESS,PNUM
EXTERNAL JOBDDT;
PNUM: 0
MOVE P,JOBFF
SKIPGE A,@(RA)
OUTCHR ["-"]
MOVMS A
PUSHJ P,DECPNT
OUTPUT TTY,0
JRA RA,1(RA)
RDNUM: 0 ;NUMBER READER FOR FOOTRAN ROUTINES.
MOVE P,JOBFF ;GET TEMP. PDL
EXCH FL,FLSV1
RDNUM1: TLO FL,SNUMF1
PUSHJ P,SCAN
CAMN A,MINV ;A MINUS SIGN ?
TLOA FL,MINFLG ;YES. SET FLAG AND LOOP BACK.
TLNN A,NUMFLG ;IT IS A NUMBER, ISN'T IT ?
JRST RDNUM1 ;NO. IGNORE IT.
TLZE FL,MINFLG ;YES. HAVE WE SEEN A MINUS LATELY ?
MOVNS C ;YES.
MOVEM C,@(RA) ;PUT VALUE INTO PARAMETER.
EXCH FL,FLSV1
JRA RA,1(RA) ;RETURN TO (UGH ! BLETCH !) FOOTRAN.
MESS: 0 ;MESSAGE PRINTER FOR FOOTRAN ROUTINES.
HRRZ (RA) ;GET LOC. OF MESSAGE.
CALLI 3
JRA RA,1(RA)
FOOPRT: 0
MOVM A,@(RA)
TLNE A,777000
FIX A,233000
PUSHJ P,DECPNT
OUTPUT TTY,0
JRST 1(RA)
COMMND: MOVEI [ASCII /$/]
CALLI 3
PUSHJ P,SCANNS ;GET COMMAND.
JUMPL A,COMND1
MOVE ACCUM
MOVE 1,ACCUM+1
LSHC 6
CAMN [SIXBIT /SET/]
JRST SETLET
CAMN [SIXBIT /RESET/]
JRST REST1
CAMN [SIXBIT /PRINT/]
JRST CPNT ;A 'PRINT' COMMAND.
CAMN [SIXBIT /P/]
JRST CPLX
CAMN [SIXBIT /DDT/]
JRST @JOBDDT
COMND1: MOVEI [ASCIZ /?? /]
CALLI 3
JRST SCHOWN
EXTERNAL NICCOM
NICB6: POINT 6,1,5
NICB7: POINT 7,NICCOM,20
SETLET: PUSHJ P,SCANR
ILDB 0,NICB6
ADDI 0,40
IDPB 0,NICB7
ILDB 0,NICB6
ADDI 0,40
IDPB 0,NICB7
JRST SCHOWN
CPLX: PUSHJ P,CGNUM ;GET FOLLOWING NUMBER, IF ANY.
MOVEI T,1 ;NO NUMBER. TAKE AS 1.
CPLAY:
MOVEM T,NVST#
MOVE T,SOUTWC
MOVEM T,OUTWC
JSA 16,IMMPLY
MOVE T,NVST
SOJG T,CPLAY ;REPEAT AS INDICATED BY ARGUMENT.
JRST SCHOWN
REST1: MOVEI TEMPSY
MOVEM BUCTBL
JRST GO
;MORE COMMAND ROUTINES.
CPNT: PUSHJ P,SCOMPA ;INIT. THE COMPILER.
PUSH OSP,[XWD VRBLBT,[XWD VRBLBT,CPNTX#]] ;PUT FAKE VARIABLE IN STACK.
PUSHJ P,ASTMT1 ;COMPILE RIGHT PART OF AN ASSIGNENT STATEMENT.
PUSHJ P,INTERP ;EXECUTE THE CODE.
SKIPL CPNTX ;'-'??
JRST NOMIN
MOVEI A,55
SOSGE TOB+2
OUTPUT TTY,0
IDPB A,TOB+1
NOMIN: MOVM A,CPNTX ;GET ITS VALUE.
TLNE A,377000 ;ASSUMING ITS >0, IS IT FLOATING?
FIX A,233000
CPNT2: PUSHJ P,DECPNT ;PRINT IT.
OUTPUT TTY,0
POP P,A ;GET THING WHICH TERMINATED EXPR. (LEFT ON STACK BY ASTMT1).
CAMN A,SEMICV ;A SEMICOLON ?
JRST SCHOWN ;YES. FORGET IT.
JRST CHOWN ;NO. LOOK AT IT.
CGNUM: TLO FL,SNUMF1 ;DONT PUT NO.'S IN TABLE.
PUSHJ P,SCAN ;LOOK FOR (OPTIONAL) NUMERIC ARGUMENT.
TLNN A,NUMFLG ;IS THERE ONE ?
POPJ P, ;NO.
MOVE T,C ;YES. GET VALUE.
TLNN A,FIXFLG ;IS IT FLOATING ?
FIX T,233000 ;NOT ANY MORE.
CGNUM2: POP P,T1 ;GET RETURN ADDR.
JRST 1(T1) ;SKIP ON RETURN.
END GO